[發問] 新手發問有關活頁中的圖片操作

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

2^#

發表於 2014-4-7 14:01 | 顯示全部帖子

回復 2# GBKEE
GBKEE 大：
                  原先的程式碼本來在輸入編號就沒問題只是在插入相片時會有錯誤產生
                  我將原始的程式碼改成你建議的方式還是出現一樣的錯誤問題
                  還能怎麼修改呢？

HELLO !!

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

3^#

發表於 2014-4-7 19:01 | 顯示全部帖子

回復 4# GBKEE
請教 GBKEE 大：
你所謂的2003可以是指可以輸入流水編號，還是說連插入圖片也可以？
因為我執行你建議程式碼只有選取符合的儲存格最後停在k=50的那個儲存格

另外請教一個 For Each... Next 的觀念問題？
是否這個用法只針對「未運算執行巨集程式前」之「符合條件的所有物件集合」？
換言之就是以我自己的這個例子來說
Set picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
我的物件集合picNumRng是在For Next迴圈執行之後才會「逐一」運算產生符合的物件
而不是在運算之前就已經完全得知所有的物件
在運用此種逐一產生的物件是否就必須再搭配For Next用法而不是 For Each... Next
不知道這樣表達夠不夠清楚

HELLO !!

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

4^#

發表於 2014-4-7 22:53 | 顯示全部帖子

回復 6# c_c_lai
c_c_lai 大：
經過修改後測試確實可以執行但是因為使用「ActiveSheet.Shapes(k)」的用法的關係
由於我在活頁中也設計了一個執行按鈕所以這個用法會去抓這個按鈕的圖示再貼到我指定儲存格
（如果沒有設計該按鈕的話您所建議的程式碼確實都是可以符合我的需求的）
這個部分我比不知道怎麼改善所以就試著使用GBKEE大的建議方法
不過還是感謝c_c_lai 大的協助讓我學到 .Shapes(k) 以及 myPhoto = Dir 的用法
感激…

HELLO !!

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

5^#

發表於 2014-4-7 22:58 | 顯示全部帖子

回復 7# GBKEE
GBKEE 大：
感謝清楚的範例解決我的觀念問題  我也利用這個小例子改善我原先的程式碼
確實已經可以執行了萬分感謝
以下也貼上我修改後的程式碼  讓有需要的人也可以學習
如果能讓程式碼更簡潔的話也請其他大大指教
----------------------------------------------------------------------------------------------
Sub photoConv1()
Dim myFSO As New FileSystemObject
Dim myPath As String
Dim picNumRng As Range, myPic As Object
Dim myPhoto As String, countPhoto As String
Dim E As Variant
Dim i As Integer, j As Integer, k As Integer

myPath = ThisWorkbook.Path                                                                                                       '確認活頁簿所在路徑
myPhoto = Dir(myPath & "\" & "原始相片" & "\" & "*.jpg")                                                 '圖片檔路徑
countPhoto = myFSO.GetFolder(myPath & "\" & "原始相片").Files.Count - 1                '取得相片數量
If myPhoto <> "" Then                                                                                                                      '資料夾中有相片時複製表格
      j = 50
      ActiveSheet.Cells(27, 3).Value = ActiveSheet.Cells(3, 3).Value
      ActiveSheet.Cells(28, 7).Value = ActiveSheet.Cells(4, 7).Value
      ActiveSheet.Cells(27, 7).Value = ActiveSheet.Cells(3, 7).Value
      ActiveSheet.Cells(27, 8).Value = ActiveSheet.Cells(3, 8).Value
      ActiveSheet.Cells(27, 10).Value = ActiveSheet.Cells(3, 10).Value
      ActiveSheet.Cells(27, 12).Value = ActiveSheet.Cells(3, 12).Value
      ActiveSheet.Cells(27, 14).Value = ActiveSheet.Cells(3, 14).Value

      For i = 1 To ((countPhoto + 1) \ 2 - 1)
         Rows("1:49").Copy                                                                                                                         '複製表格
         ActiveSheet.Paste Cells(j, 1)
         j = j + 49
      Next i

      For k = 1 To countPhoto
         Set picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
            picNumRng = k                                                                                                                         '輸入相片編號
            For Each E In picNumRng
            Set myPic = ActiveSheet.Pictures.Insert(myPath & "\" & "原始相片" & "\" & E & ".jpg") '插入與儲存格同名的相片檔
            With myPic
                  .ShapeRange.LockAspectRatio = msoFalse
                  .Top = picNumRng.Offset(0, 1).Top
                  .Left = picNumRng.Offset(0, 1).Left
                  .Width = picNumRng.Offset(0, 1).MergeArea.Width
                  .Height = picNumRng.Offset(0, 1).MergeArea.Height
            End With
            Next
      Next k
Else
      MsgBox "資料夾中沒有相片"
End If
Set picNumRng = Nothing
Set myPic = Nothing
End Sub

HELLO !!

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

6^#

發表於 2014-4-8 16:42 | 顯示全部帖子

回復 10# GBKEE
果然可以用更精簡的方法來撰寫待我慢慢消化了解  感謝…
想請教Set picNumRng = .Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))這行程式碼
為何Range前方又多了一個「.」用意為何？

另外請教GBKEE大：
因為我的表格是預設表格（列高必須是固定的）所以才會使用下列程式碼
      For i = 1 To ((countPhoto + 1) \ 2 - 1)
         Rows("1:49").Copy                                                 '複製表格
         ActiveSheet.Paste Cells(j, 1)
         j = j + 49
      Next i
會使用這方式是因為全列複製才能保持列高如果以range範圍來複製表格範圍列高會不一致
但此種方法的缺點就是在我表格右手邊設計的按鈕也會一併複製也就是複製幾次表格就出現幾個按鈕
能否解決複製表格同時又可保持列高而且巨集按鈕又不會影響到？

HELLO !!

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

7^#

發表於 2014-4-8 20:04 | 顯示全部帖子

回復 12# GBKEE
GBKEE 大：
嘗試過後沒問題感謝
正在試著了解你的寫法中

HELLO !!

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

8^# 倒序看帖

打印

字體大小: tT

發表於 2014-4-9 17:12 | 顯示全部帖子

[發問] 新手發問有關活頁中的圖片操作

請教各位前輩在設計自己需求的程式遇到問題時會怎麼解決？
1.可以巨集錄製時，先錄製來看使用何方法或物件
2.無法錄製時，到F1說明以關鍵字搜尋看有無類似說明
3.GOOGLE大神搜尋法

假設現在我的問題是要「對調」活頁中現存的圖片
我先用錄製巨集方法得知EXCEL是用下列程式碼來選取圖片
「ActiveSheet.Shapes.Range(Array("Picture 4")).Select」
所以我也比照此法設定變數後再進行兩個圖片的對調
但是卻失敗了
由於先前所學知道插入圖片是ActiveSheet.Pictures.Insert
再來到說明以Pictures為關鍵字去搜尋可是也找不到
最後的GOOGLE大神也因為不知道該怎麼下關鍵字找不到符合需求的
有沒有前輩願意分享經驗

HELLO !!

帖子: 36
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: windows xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-2-20
最後登錄: 2015-3-6

9^#

發表於 2014-4-10 09:15 | 顯示全部帖子

相片冊製作 v1.0.rar (61.14 KB) 回復 2# GBKEE
預設情形說明：
由於表格是複製編號1及編號2的表格而來所以每次新增相片會多出兩個空白相片儲存格
如果我只是要新增1張相片的話就必須將下方的相片往上遞補至新的表格
就效率上來說似乎是下列方法2比較有效率
1.假設新增插入編號11的相片，刪除原先編號11之後的相片及表格，重新複製所需表格，新增編號11相片再讀入資料夾的相片自編號12開始貼
2.假設新增插入編號11的相片，複製新表格（2空白相片儲存格）插入，新增編號11相片再將活頁中的相片依序往上遞補1張

以上說明若有說明不清楚的煩請再指教

HELLO !!