[µo°Ý] Ū¨ú¹Ï¤ù¹³¯À

acdx

§Ú­n¿ï¨ú¹Ï¤ù¨ÃŪ¨ú¸Ó¹Ï¤ùªº¹³¯À, ¤U­±ªº§@ªkµLªk­­©w¥u§ì.jpgÀÉ·|³s¦P¸ê®Æ§¨¤º©Ò¦³Àɮ׳£·|¤@¤@Ū¨ú, ¸Ó¦p¦ó§ï¦¨¥u§ì.jpgÀÉ?
pic2.zip (19.34 KB)

¤U¸ü¦¸¼Æ: 11

2021-2-19 17:09

Sub Pics()

Dim PicList As Variant, sFile As Variant
Dim oShell As Variant, oDir As Variant
Dim Dms(20) As String

SetCurrentDirectory ActiveWorkbook.Path
PicList = Application.GetOpenFilename(filefilter:="JPEG ÀÉ®× (*.jpg),*.jpg", FilterIndex:=5, Title:="´¡¤J¹Ï¤ù", MultiSelect:=True)
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.Namespace(CurDir)
i = 1
For Each sFile In oDir.items
    Dms(i) = sFile.extendedproperty("Dimensions")
    MsgBox (Dms(i))
i = i + 1
Next

End Sub

°a¤ªºµ

¦^´_ 1# acdx

¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý¬O¤£¬O§A­nªºµ²ªG ÁÂÁÂ

1. Sub Ū¨ú«ü©w¸ê®Æ§X·Ó¤ù¤Ø¤o½m²ß()
   
2.     Application.ScreenUpdating = False
   
3.    
   
4.     Application.FileDialog(msoFileDialogFolderPicker).Show
   
5.     B = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
   
6.     Set Sh = CreateObject("Shell.Application")
   
7.     Set Dr = Sh.Namespace(B)
   
8. 
   
9.     For Each F In Dr.Items
   
10.         If F Like "*jpg" Then
    
11.             E = F.extendedproperty("Dimensions")
    
12.             Debug.Print Mid(E, 2, Len(E) - 2)
    
13.         End If
    
14.     Next
    
15.    
    
16.     Set Sh = Nothing
    
17.     Set Dr = Nothing
    
18.     Set F = Nothing
    
19.     E = "": B = ""
    
20. 
    
21.     Application.ScreenUpdating = True
    
22. End Sub

½Æ»s¥N½X