- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
18#
發表於 2014-4-10 14:18
| 只看該作者
本帖最後由 GBKEE 於 2014-4-10 16:09 編輯
回復 16# baconbacons
由於表格是複製編號1及編號2的表格而來 所以每次新增相片會多出兩個空白相片儲存格
Q:為何一次要,複製編號1及編號2的表格
1.假設新增插入編號11的相片，刪除原先編號11之後的相片及表格，重新複製所需表格，新增編號11相片再讀入資料夾的相片自編號12開始貼
Q: 新增插入編號11的相片,為何是:刪除原先編號11之後的相片及表格,而不包含原先編號11相片及表格,
為何是:自編號12開始貼,不是自編號11開始貼
2.假設新增插入編號11的相片，複製新表格（2空白相片儲存格）插入，新增編號11相片再將活頁中的相片依序往上遞補1張
Q:為何要: 複製新表格（2空白相片儲存格）插入,多一空白位置爾後將相片依序往上遞補1張(多此一舉)
是這樣嗎?- Sub Ex()
- Dim myFSO As New FileSystemObject
- Dim Rng As Range, i As Integer
- Dim myPath As String
- Dim E As Variant
- myPath = ThisWorkbook.Path & "\原始相片" '相片的資料夾
- If myFSO.GetFolder(myPath).Files.Count > 0 Then '有檔案
- With ActiveSheet '指定工作表
- .Pictures.Delete '刪除所有相片
- Set Rng = .[A3:O25] '相片表格
- .Rows("26:" & .UsedRange.Rows.Count).Clear '清除 第一張相片以後的表格
- For Each E In myFSO.GetFolder(myPath).Files '檔案物件集合
- If UCase(E) Like "*.JPG" Then 'E (檔案物件)傳回完整路徑名稱 , Like 比對是否有".JPG"的字元
- With Rng.Offset((i) * Rng.Rows.Count + (i * 1)) '相片的表格位置
- If i > 0 Then '第2張後
- Rng.Copy
- .PasteSpecial xlPasteFormats
- .Value = Rng.Value
- .Range("A3") = i + 1 '相片的表格位置的Range("A3")
- End If
- .Range("C22") = E
- .Range("B3").Select '相片的表格位置的Range("B3")
- End With
- With .Pictures.Insert(E) '插入P檔案物件(相片)
- .ShapeRange.LockAspectRatio = msoFalse
- .Top = Selection(1, 1).Top
- .Left = Selection(1, 1).Left
- .Width = Selection.Width
- .Height = Selection.Height
- End With
- i = i + 1
- End If
- Next
- End With
- End If
- MsgBox myPath & " 資料夾中" & IIf(i > 0, "共" & i & "張", "沒有") & "相片"
- End Sub
|
|
發表於 2014-4-8 16:42
| 
