- 帖子
- 95
- 主題
- 29
- 精華
- 0
- 積分
- 150
- 點名
- 0
- 作業系統
- windows2003
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 男
- 來自
- Kaoshiung
- 註冊時間
- 2010-11-5
- 最後登錄
- 2018-2-8
|
8#
發表於 2012-2-20 10:15
| 只看該作者
回復 7# Hsieh
感謝版主的指正,其實這幾段程式也是先前請版主指正拼湊出來的,小弟不是很懂其中的意思,剛才的程式試run了一下,圖片一直重疊,debug後,發現sheet(i)沒有累加,現已經ok,2003年版的excel
picture,insert( ),無法延用至2010年版,小弟現在了解了,實在感謝!- Sub STARTGETSINF()
- Dim Fs As Object, E, i As Integer, P, ii As Integer
- Dim xlPath As String
- Dim myWb As Workbook
- Dim myFileName As String
- Cells.Clear
- ActiveWindow.Zoom = 75
- Rows("2:9999").EntireRow.AutoFit
- Columns("B:Y").ColumnWidth = 2
- With Application.FileDialog(msoFileDialogFolderPicker)
- .AllowMultiSelect = False
- .InitialFileName = "D:\Export\SINF\"
- .Show
- If .SelectedItems.Count = 0 Then Exit Sub
- xlPath = .SelectedItems(1)
- End With
- With CreateObject("Scripting.FileSystemObject").GetFolder(xlPath)
- i = 1
- For Each E In .SubFolders
- If i > ActiveWorkbook.Sheets.Count Then
- Sheets.Add(, Sheets(Sheets.Count)).Name = E.Name
- Else
- Sheets(i).Name = E.Name
- End If
- ii = 2
- For Each P In E.Files
- If InStr(UCase(P.Name), ".JPG") Then
- ActiveWindow.Zoom = 75
-
- With Sheets(i).Cells(ii, 2).Select '設定圖片欄位大小
- With Selection
- .RowHeight = 60
- .ColumnWidth = 9.5
- .WrapText = True
- End With
-
- t = Cells(ii, 2).Top + Cells(ii, 2).Height * 0.1 '圖片上位置
- l = Cells(ii, 2).Left + Cells(ii, 2).Width * 0.1 '圖片左位置
- w = 50 '圖片縮小50%寬度
- h = 50 '圖片縮小50%高度
- With Sheets(i).Shapes.AddPicture(P, True, True, l, t, w, h) 'B欄插入圖片
- .Placement = xlMove '圖片大小隨儲存格位置而改變
- With Sheets(i) 'A欄插入圖片名稱
- '.Cells(ii, 1) = P.Name '圖片檔案名稱
- .Cells(ii, 1) = P '圖片檔案完整路徑
- End With
- End With
- End With
- ii = ii + 1 '一次跳的欄位數
- End If
- Next
- [b][color=Red]i = i + 1[/color][/b] Next
- End With
-
- End Sub
|
|
發表於 2012-2-17 14:24
| 
