南宫飘雪
Thành viên mới
- Tham gia
- 10/10/15
- Bài viết
- 20
- Được thích
- 30
Định dạng tệp mà mô-đun này hỗ trợ:
Kết quả kiểm tra(mô-đun này đã vượt qua hoàn hảo các bài kiểm tra của XP + Office2007, Win7 + Office2010 (64-bit), Win7 + Office2007 (32-bit), Win10 + Office2019 (64-bit)):
Hướng dẫn sử dụng:
Nếu chỉ cần sử dụng các chức năng bên trong, bạn có thể xuất trực tiếp mô-đun basSaveRangeToPictrue sang các tệp khác, sau đó gọi hàm SaveRangeToPictrue theo cách gọi của mã kiểm tra trên, Ngoài ra còn có hai hàm là SaveClipboardToPictrue và SaveBitmapToFile và bạn cũng có thể sử dụng riêng Tham khảo định dạng và hướng dẫn trong mã gốc để gọi kết hợp với tình huống của riêng bạn. Ví dụ, nếu bạn muốn xuất biểu tượng Ribbon trong Excel sang ICO hoặc PNG, bạn có thể xuất trực tiếp ra tệp đĩa miễn là bạn tham khảo phương pháp sử dụng SaveBitmapToFile (mã kiểm tra trên cũng chứa Bản giới thiệu).
Cuối cùng, Tệp nguồn được tải xuống tại đây: SaveRangeToPictrue_EN.xlsm
- Định dạng ảnh BMP: tệp bitmap 32-bit, không hỗ trợ độ trong suốt;
- Định dạng ảnh PNG: tạo ảnh nén 32-bit không mất dữ liệu với các kênh trong suốt;
- Định dạng hình ảnh ICO: Tạo biểu tượng trong suốt Windows XP (Lưu ý: Biểu mẫu VBA có thể không được sử dụng trực tiếp, không được VBA hỗ trợ). Cần lưu ý rằng nếu không sử dụng ICO_SizeOrTIFF_COMPRESSION khi gọi hàm, biểu tượng tương ứng với kích thước được chỉ định, khi đó biểu tượng được tạo và Khu vực phạm vi có cùng kích thước. Điều này có nghĩa là biểu tượng được tạo không phải là biểu tượng hình vuông phổ biến như 32 × 32 hoặc 256 × 256;
- Định dạng ảnh TGA: Tạo ảnh TGA 32 bit với nén không mất dữ liệu lwz kênh trong suốt. Vì ảnh TGA có thể được OpenGL gọi trực tiếp là họa tiết 3D, chúng thường phổ biến trong các tài liệu trò chơi cũ cách đây hơn mười năm, nhưng cần lưu ý rằng nếu bạn sử dụng nó PS sẽ bỏ qua kênh trong suốt (bao gồm cả hình ảnh TGA trong suốt do PS tạo ra) khi PS mở tệp TGA, nhưng phần mềm khác vẫn bình thường;
- Định dạng ảnh JPG / JPEG: định dạng ảnh nén mất dữ liệu phổ biến nhất, không hỗ trợ độ trong suốt;
- Định dạng hình ảnh TIFF: không hỗ trợ độ trong suốt
- Định dạng ảnh GIF: Định dạng ảnh GIF với nền trong suốt không được hỗ trợ (Lưu ý: Bản thân định dạng GIF hỗ trợ độ trong suốt, nhưng tôi lười và không tự tạo tệp GIF nhị phân, vì vậy tệp GIF được lưu bởi mô-đun này không hỗ trợ độ trong suốt của nền);
- Định dạng ảnh SVG: Đồ họa vector, bạn có thể sử dụng các trình duyệt web chính thống để mở và xem trực tiếp một số loại ảnh.
- Định dạng hình ảnh WMF: biểu đồ vector；
- Định dạng ảnh EMF: biểu đồ vectơ；
- Định dạng tệp PDF；
- Định dạng tệp XPS: Nên sử dụng XPS Viewer để xem (Win10 đi kèm với nó, nhưng nó cần được thêm thủ công vào thành phần)
- Định dạng tệp ZIP: Mục này chỉ để giúp chúng tôi đóng gói các tệp được tạo ở trên thành một tệp. Gọi trực tiếp Shell32 để tạo mà không cần hỗ trợ DLL của bên thứ ba.
Mã:
Sub TestSaveRangeToPictrue()
Dim PathName As String
Dim FileNames() As String
Dim FileName As String
Dim I As Long
PathName = ThisWorkbook.Path & Application.PathSeparator
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a Directory to Save Pictures:"
.InitialFileName = PathName
.Show
If .SelectedItems.Count Then
PathName = .SelectedItems(1)
Else
MsgBox "You choose to Cancel,The program well stop."
Exit Sub
End If
End With
Debug.Print "=============== Test Start ===================="
PathName = ThisWorkbook.Path & Application.PathSeparator
FileNames = Split("WMF,EMF,PDF,XPS", ",")
For I = 0 To UBound(FileNames)
FileName = PathName & "SaveRangeTo" & FileNames(I) & "(Vector)." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "Success", "Failure") & "]: Save" & FileNames(I) & "File""" & FileName & """"
FileName = PathName & "Pictures.ZIP>Vector\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "success", "failure") & "]: add " & FileNames(I) & " file to ""Pictures. ZIP"""
Next
FileNames = Split("BMP,PNG,ICO,JPG,TIF,TGA,SVG,GIF", ",")
For I = 0 To UBound(FileNames)
FileName = PathName & "SaveRangeTo" & FileNames(I) & "(NoAlpha)." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "Success", "Failure") & "]: Save" & FileNames(I) & "File""" & FileName & """"
FileName = PathName & "Pictures.ZIP>NoAlpha\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "success", "failure") & "]: add " & FileNames(I) & " pictures to ""Pictures. ZIP"""
Next
FileNames = Split("PNG,ICO,TGA,SVG", ",")
For I = 0 To UBound(FileNames)
FileName = PathName & "SaveRangeTo" & FileNames(I) & "(AlphaBackColor)." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1), "Success", "Failure") & "]: Save" & FileNames(I) & "File"" " & FileName & """"
FileName = PathName & "Pictures.ZIP>Alpha\AlphaBackColor\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1), "Success", "Failure") & "]: Add ""SaveRangeTo" & FileNames(I) & "." & FileNames(I) & """into ""Pictures.ZIP"""
FileName = PathName & "SaveRangeTo" & FileNames(I) & "(AlphaHalfForBackColor)." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1, 128), "Success", "Failure") & "]: Save" & FileNames(I) & "File """ & FileName & """"
FileName = PathName & "Pictures.ZIP>Alpha\AlphaHalfForBackColor\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1, 128), "Success", "Failure") & "]: Add ""SaveRangeTo" & FileNames(I) & "." & FileNames(I) & """into ""Pictures.ZIP"""
FileName = PathName & "SaveRangeTo" & FileNames(I) & "(AlphaHalfForAll)." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -2, 128), "Success", "Failure") & "]: Save" & FileNames(I) & "File """ & FileName & """"
FileName = PathName & "Pictures.ZIP>Alpha\AlphaHalfForAll\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -2, 128), "Success", "Failure") & "]: Add ""SaveRangeTo" & FileNames(I) & "." & FileNames(I) & """into ""Pictures.ZIP"""
Next
Debug.Print "=============== Test End ===================="
End Sub
Sub TestSaveImageMso()
Dim PathName As String
Dim FileNames() As String
Dim FileName As String
Dim I As Long
PathName = ThisWorkbook.Path & Application.PathSeparator
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a Directory to Save Pictures:"
.InitialFileName = PathName
.Show
If .SelectedItems.Count Then
PathName = .SelectedItems(1)
Else
MsgBox "You choose to Cancel,The program well stop."
Exit Sub
End If
End With
PathName = ThisWorkbook.Path & Application.PathSeparator
FileNames = Split("About,AccessRecycleBin,BlogHomePage,ClearGrid,Folder", ",")
For I = 0 To UBound(FileNames)
FileName = PathName & FileNames(I)
With CommandBars.GetImageMso(FileNames(I), 32, 32)
Debug.Print "[" & IIf(SaveBitmapToFile(.Handle, FileName & ".PNG", &HFFFFFF), "Success", "Failure") & "]: Save """ & FileNames(I) & """ icon To file """ & FileName & ".PNG"; "File"
Debug.Print "[" & IIf(SaveBitmapToFile(.Handle, FileName & ".ICO", &HFFFFFF, , 32), "Success", "Failure") & "]: Save """ & FileNames(I) & " ""Icon to File""" & FileName & ".ICO"; "File"
End With
Next
End SubKết quả kiểm tra(mô-đun này đã vượt qua hoàn hảo các bài kiểm tra của XP + Office2007, Win7 + Office2010 (64-bit), Win7 + Office2007 (32-bit), Win10 + Office2019 (64-bit)):
Hướng dẫn sử dụng:
Nếu chỉ cần sử dụng các chức năng bên trong, bạn có thể xuất trực tiếp mô-đun basSaveRangeToPictrue sang các tệp khác, sau đó gọi hàm SaveRangeToPictrue theo cách gọi của mã kiểm tra trên, Ngoài ra còn có hai hàm là SaveClipboardToPictrue và SaveBitmapToFile và bạn cũng có thể sử dụng riêng Tham khảo định dạng và hướng dẫn trong mã gốc để gọi kết hợp với tình huống của riêng bạn. Ví dụ, nếu bạn muốn xuất biểu tượng Ribbon trong Excel sang ICO hoặc PNG, bạn có thể xuất trực tiếp ra tệp đĩa miễn là bạn tham khảo phương pháp sử dụng SaveBitmapToFile (mã kiểm tra trên cũng chứa Bản giới thiệu).
Cuối cùng, Tệp nguồn được tải xuống tại đây: SaveRangeToPictrue_EN.xlsm
Lần chỉnh sửa cuối:
