標題: [發問] 讀取圖片像素 [打印本頁]

---

作者: acdx    時間: 2021-2-19 17:09     標題: 讀取圖片像素

我要選取圖片並讀取該圖片的像素, 下面的作法無法限定只抓.jpg檔會連同資料夾內所有檔案都會一一讀取, 該如何改成只抓.jpg檔?
[attach]33066[/attach]
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:="插入圖片", 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

---

作者: 軒云熊    時間: 2021-2-20 02:44

本帖最後由 軒云熊 於 2021-2-20 02:55 編輯

回復 1# acdx

有空幫我試試看是不是你要的結果 謝謝

1. Sub 讀取指定資料匣照片尺寸練習()
   
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

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)