ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[­ì³Ð] Excel«O¦s单¤¸®æ区°ì为图¤ù

[­ì³Ð] Excel«O¦s单¤¸®æ区°ì为图¤ù

¥»©«³Ì«á¥Ñ Joforn ©ó 2020-12-1 20:03 ½s¿è

¥ý¤W´ú¸Õ¥N½X¡G
  1. Sub TestSaveRangeToPictrue()
  2.   Dim PathName As String
  3.   Dim FileNames() As String
  4.   Dim FileName As String
  5.   Dim I As Long
  6.   
  7.   
  8.   Debug.Print "=============¶}©l´ú¸Õ¤å¥ó¿é¥X==================="
  9.   PathName = ThisWorkbook.Path & Application.PathSeparator
  10.   
  11.   FileNames = Split("WMF,EMF,PDF,XPS", ",")
  12.   For I = 0 To UBound(FileNames)
  13.     FileName = PathName & "SaveRangeTo" & FileNames(I) & "(¥Ú¶q)." & FileNames(I)
  14.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "¦¨¥\", "¥¢±Ñ") & "]¡G«O¦s" & FileNames(I) & "¤å¥ó""" & FileName & """"
  15.     FileName = PathName & "Pictures.ZIP>¥Ú¶q\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
  16.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "¦¨¥\", "¥¢±Ñ") & "]¡G²K¥[" & FileNames(I) & "¤å¥ó¨ì""Pictures. ZIP"""
  17.   Next
  18.   
  19.   FileNames = Split("BMP,PNG,ICO,JPG,TIF,TGA,SVG,GIF", ",")
  20.   For I = 0 To UBound(FileNames)
  21.     FileName = PathName & "SaveRangeTo" & FileNames(I) & "(µL³z©ú)." & FileNames(I)
  22.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "¦¨¥\", "¥¢±Ñ") & "]¡G«O¦s" & FileNames(I) & "¤å¥ó""" & FileName & """"
  23.     FileName = PathName & "Pictures.ZIP>µL³z©ú\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
  24.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName), "¦¨¥\", "¥¢±Ñ") & "]¡G²K¥[" & FileNames(I) & "¹Ï¤ù¨ì""Pictures. ZIP"""
  25.   Next
  26.   
  27.   FileNames = Split("PNG,ICO,TGA,SVG", ",")
  28.   For I = 0 To UBound(FileNames)
  29.     FileName = PathName & "SaveRangeTo" & FileNames(I) & "(­I´º¥þ³z)." & FileNames(I)
  30.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1), "¦¨¥\", "¥¢±Ñ") & "]¡G«O¦s" & FileNames(I) & "¤å¥ó"" " & FileName & """"
  31.     FileName = PathName & "Pictures.ZIP>³z©ú\­I´º¥þ³z\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
  32.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1), "¦¨¥\", "¥¢±Ñ") & "]¡G²K¥[" & FileNames(I) & "­I´º¥þ³z©ú¹Ï¤ù¨ì""Pictures.ZIP"""
  33.     FileName = PathName & "SaveRangeTo" & FileNames(I) & "(­I´º¥b³z)." & FileNames(I)
  34.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1, 128), "¦¨¥\", "¥¢±Ñ") & "]¡G«O¦s" & FileNames(I) & "¤å¥ó""" & FileName & """"
  35.     FileName = PathName & "Pictures.ZIP>³z©ú\­I´º¥b³z\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
  36.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -1, 128), "¦¨¥\", "¥¢±Ñ") & "]¡G²K¥[" & FileNames(I) & "­I´º¥b³z©ú¹Ï¤ù¨ì""Pictures.ZIP"""
  37.     FileName = PathName & "SaveRangeTo" & FileNames(I) & "(¾ãÅé¥b³z)." & FileNames(I)
  38.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -2, 128), "¦¨¥\", "¥¢±Ñ") & "]¡G«O¦s" & FileNames(I) & "¤å¥ó""" & FileName & """"
  39.     FileName = PathName & "Pictures.ZIP>³z©ú\¾ãÅé¥b³z\SaveRangeTo" & FileNames(I) & "." & FileNames(I)
  40.     Debug.Print "[" & IIf(SaveRangeToPictrue(Range("L1:R21"), FileName, -2, 128), "¦¨¥\", "¥¢±Ñ") & "]¡G²K¥[" & FileNames(I) & "¾ãÅé¥b³z©ú¹Ï¤ù¨ì""Pictures.ZIP"""
  41.   Next
  42.   Debug.Print "=============¡@¡@´ú¸Õµ²§ô¡@¡@==================="
  43. End Sub


  44. Sub TestSaveImageMso()
  45.   Dim PathName As String
  46.   Dim FileNames() As String
  47.   Dim FileName As String
  48.   Dim I As Long
  49.   
  50.   On Error Resume Next
  51.   
  52.   PathName = ThisWorkbook.Path & Application.PathSeparator
  53.   FileNames = Split("About,AccessRecycleBin,BlogHomePage,ClearGrid,Folder", ",")
  54.   For I = 0 To UBound(FileNames)
  55.     FileName = PathName & FileNames(I)
  56.     With CommandBars.GetImageMso(FileNames(I), 32, 32)
  57.       Debug.Print "[" & IIf(SaveBitmapToFile(.Handle, FileName & ".PNG", &HFFFFFF), "¦¨¥\", "¥¢±Ñ") & "]¡G«O¦s""" & FileNames(I) & """¹Ï¼Ð¨ì¤å¥ó""" & FileName & ".PNG""¤å¥ó"
  58.       Debug.Print "[" & IIf(SaveBitmapToFile(.Handle, FileName & ".ICO", &HFFFFFF, , 32), "¦¨¥\", "¥¢±Ñ") & "]¡G«O¦s""" & FileNames(I) & " ""¹Ï¼Ð¨ì¤å¥ó""" & FileName & ".ICO""¤å¥ó"
  59.     End With
  60.   Next
  61. End Sub
½Æ»s¥N½X



´ú¸Õ®ÄªG(¥»¼Ò²Õ¤w§¹¬ü³q¹LXP+Office2007¡BWin7+Office2010(64¦ì)¡BWin7+Office2007(32¦ì)¡BWin10+Office2019(64¦ì)´ú¸Õ)¡G

SaveRangeToPictrue.gif
2020-12-1 19:50


¥»¼Ò¶ô¤ä«ù¥Í¦¨ªº¤å¥ó®æ¦¡¡G
1¡BBMP¹Ï¤ù®æ¦¡¡G32¦ì¦ì¹Ï¤å¥ó ¡A¤£¤ä«ù³z©ú¡F
2¡BPNG¹Ï¤ù®æ¦¡¡G¥Í¦¨32¦ì±a³z©ú³q¹DµL·lÀ£ÁY¹Ï¤ù¡F
3¡BICO¹Ï¤ù®æ¦¡¡G¥Í¦¨Windows XP³z©ú¹Ï¼Ð¡]ª`¡GVBAµ¡Å餤¥i¯à¤£¯àª½±µ¨Ï¥Î¡A¤£³QVBA¤ä«ù¡^¡A­nª`·Nªº¬O¡A¦pªG¨S¦³¬°¹Ï¼Ð¹ïÀ³«ü©w¤Ø¤o¡A¨º¤\¥Í¦¨ªº¹Ï¼Ð©MRange°Ï°ì¤j¤p¬Û¦P¡A¤]´N¬O»¡¥Í¦¨ªº¹Ï¼Ð¨Ã¤£¬O±`¨£32¡Ñ32©Î256¡Ñ256¤§Ãþªº¥¿¤è«¬¹Ï¼Ð¡F
4¡BTGA¹Ï¤ù®æ¦¡¡G¥Í¦¨32¦ì±a³z©ú³q¹DlwzµL·lÀ£ÁYªºTGA¹Ï¤ù¡A¥Ñ©óTGA¹Ï¤ù¥i³QOpenGLª½±µ½Õ¥Î°µ¬°3D¶K¹Ï¡A¬G¦Ó±`¨£©ó¤Q¦h¦~«eªº¦Ñ¹CÀ¸¯À§÷¤¤¡A¦ý¬O­nª`·Nªº¬O¦pªG¨Ï¥ÎPS¥´¶}TGA¤å¥óªº¸Ü¡APS·|©¿²¤±¼³z©ú³q¹D¡]¥]¬APS¦Û¤v¥Í¦¨ªº³z©úTGA¹Ï¡^¡A¦ý¨ä¥¦³n¥ó¥¿±`¡F
5¡BJPG/JPEG¹Ï¤ù®æ¦¡¡G³Ì±`¨£ªº¦³·lÀ£ÁY¹Ï¤ù®æ¦¡¡A¤£¤ä«ù³z©ú¡F
6¡BTIFF¹Ï¤ù®æ¦¡¡G¤£¤ä«ù³z©ú
7¡BGIF¹Ï¤ù®æ¦¡¡G¤£¤ä«ù­I´º³z©úªºGIF¹Ï¤ù®æ¦¡¡]ª`·N¡GGIF®æ¦¡¥»¨­¬O¤ä«ù³z©úªº¡A¦ý¥»¤H°½Ãi¡A¨S¥h¥Ñ¦Û¤v¥Í¦¨¤G¶i¨îªºGIF¤å¥ó¡A©Ò¥H¥»¼Ò¶ô«O¦sªºGIF¤å¥ó¤£¤ä«ù­I´º³z©ú¡^¡F
8¡BSVG¹Ï¤ù®æ¦¡: ¥Ú¶q¹Ï¡A¥i¥H¨Ï¥Î¥D¬yºô­¶ÂsÄý¾¹ª½±µ¥´¶}¬d¬Ý¨ÇÃþ¹Ï¤ù¡C
9¡BWMF¹Ï¤ù®æ¦¡¡G¥Ú¶q¹Ï
10¡BEMF¹Ï¤ù®æ¦¡¡G¥Ú¶q¹Ï
11¡BPDF¤å¥ó®æ¦¡¡G
12¡BXPS¤å¥ó®æ¦¡¡G«Øij¨Ï¥ÎXPS Viewer¬d¬Ý(Win10¦Û±a¡A¦ý»Ý¤â°Ê¦b²Õ¥ó¤¤²K¥[)
13¡BZIP¤å¥ó®æ¦¡¡G³o³f¥u¬O¬°¤FÀ°§U§Ú­Ì§â¤W­±¥Í¦¨ªº¤å¥ó¥´¥]¦¨¤@­Ó¤å¥ó¡Cª½±µ½Õ¥ÎShell32¥Í¦¨¡AµL»Ý²Ä¤T¤èDLL¤ä«ù¡C

·½½X¦b³o¸Ì¡G SaveRangeToPictrue.zip (163.49 KB)
¦pªG¥u»Ý­n¥Î¨ì¸Ì­±ªº¥\¯àªº¸Ü¡A¥i¥H¶È¶È¾É¥XbasSaveRangeToPictrue¼Ò²Õ¨ì¨ä¥¦ªºVBA±M®×¤¤¡A¨Ì·Ó¤W­±ªº´ú¸Õ¥N½X¤¤ªº¤è¦¡½Õ¥ÎSaveRangeToPictrue¨ç¼Æ´NOK¤F¡A¼Ò²Õ¤¤ÁÙ¦³SaveClipboardToPictrue¡BSaveBitmapToFile¨â­Ó¨ç¼Æ¡A¥ç¥i°Ñ·Ó­ì¥N½X¤¤ªº®æ¦¡©M»¡©úµ²¦X¦Û¤vªº¹ê»Ú»Ý¨D½Õ¥Î¡C¤ñ¦p¡G¦pªG·Q±NExcel¤¤ªºRibbon¹Ï¼Ð¾É¥X¬°ICO¤åÀɩάOPNG¤åÀÉ¡A¶È»Ý¨Ì·ÓTestSaveImageMso¤¤ªº¤èªk§Y¥i¾É¥X¨ìºÏºÐ¤¤¡C
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

¤@¼Óªºªþ¥ó§Ñ°O¥h±¼¥N½X¤¤ªºÂ²Å餤¤å¤F¡A³o­Ó¬O·sªºªþ¥ó: SaveRangeToPictrue_EN.zip (157.37 KB)
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

        ÀR«ä¦Û¦b : ¡i®É¶¡¦pÆp¥Û¡j®É¶¡¹ï¤@­Ó¦³´¼¼zªº¤H¦Ó¨¥¡A´N¦pÆp¥Û¯ë¬Ã¶Q¡F¦ý¹ï·M¤H¨Ó»¡¡A«o¹³¬O¤@§âªd¤g¡A¤@ÂI»ù­È¤]¨S¦³¡C
ªð¦^¦Cªí ¤W¤@¥DÃD