Board logo

標題: [發問] 巨集陣列的程式 [打印本頁]
作者: PJChen    時間: 2012-4-28 23:27     標題: 巨集陣列的程式

各位好,

我想寫一個巨集陣列的程式,條件如下:
從工作表"Shipping formula.xlsm"的Sheet("Signed")  copy一個圖片"Picture 1",分別貼到
"Shipping for ACE.xlsx"的Sheet("PKG","INV","SCD"),
貼的位置為Sheet("PKG")......D欄位的"TOTAL N. W."字樣+右12格
                      Sheet("INV")......Q欄位的"B. C. MART COMPANY LTD."字樣+下2格
                      Sheet("SCD")......B欄位的"Signature:"字樣+右2格

請問我該怎麼做?
作者: GBKEE    時間: 2012-4-29 07:28

回復 1# PJChen
  1. Sub Ex()
  2.     Dim Rng(1 To 3) As Range, xi As Integer
  3.     Workbooks("Shipping formula.xlsm").Sheets("Signed").Pictures(1).Copy
  4.     With Workbooks("Shipping for ACE.xlsx")
  5.         .Activate
  6.         Set Rng(1) = .Sheets("PKG").[D:D].Find("TOTAL N. W.", LOOKAT:=xlPart).Offset(0, 12)
  7.         Set Rng(2) = .Sheets("INV").[Q:Q].Find("B. C. MART COMPANY LTD.").Offset(2, 0)
  8.         Set Rng(3) = .Sheets("SCD").[B:B].Find("Signature:").Offset(0, 2)
  9.         For xi = 1 To 3
  10.             Rng(xi).Parent.Activate
  11.             Rng(xi).Activate
  12.             ActiveSheet.Paste
  13.         Next
  14.     End With
  15. End Sub
複製代碼
作者: PJChen    時間: 2012-4-29 09:49

回復 2# GBKEE

G版大,
謝謝您,進行很順利.
作者: PJChen    時間: 2012-10-9 11:57     標題: 貼簽名檔

請教各位大大:

簽名檔"Picture 6"放在"Shipping formula.xlsm"的Sheets("Signed"),
我想將簽名copy到("Accounting_Rising.xlsx").Sheets("INV")的P欄"RISING STAR COMPANY LTD."向下2格.
以下是我的寫法,但一直無法運作,可否幫忙看看語法哪裡有誤?

    Windows("Shipping formula.xlsm").Activate
    Sheets("Signed").Select
    ActiveSheet.Shapes.Range(Array("Picture 6")).Select
    Selection.Copy
    With Workbooks("Accounting_Rising.xlsx").Sheets("INV").[P:P].Find("RISING STAR COMPANY LTD.").Offset(2, 0).Activate
            ActiveSheet.Paste
    End With
作者: GBKEE    時間: 2012-10-9 14:54

回復 1# PJChen
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range
  4.     Windows("Shipping formula.xlsm").Activate
  5.     Sheets("Signed").Select
  6.     ActiveSheet.Shapes.Range(Array("Picture 6")).Select
  7.     Selection.Copy
  8.     Set Rng = Workbooks("Accounting_Rising.xlsx").Sheets("INV").[P:P].Find("RISING STAR COMPANY LTD.").Offset(2, 0)
  9.     If Not Rng Is Nothing Then
  10.         With Rng
  11.             .Parent.Activate            'Worksheet
  12.             .Activate                          'Range
  13.         End With
  14.         ActiveSheet.Paste
  15.     End If
  16. End Sub
複製代碼
作者: PJChen    時間: 2012-10-9 15:34

回復 2# GBKEE

感謝大大, ok了!
作者: PJChen    時間: 2012-10-9 21:12

回復 2# GBKEE

請問大大,
以下二種不同的寫法,會造成錯誤嗎?
我新增了 2)的簽名後,其他如1)的簽名檔,不是亂貼簽名2)的簽名,就是出現錯誤訊息!  [attach]12738[/attach]
    1) Workbooks("Shipping formula-1.xlsm").Sheets("Signed").Pictures(3).Copy

   2)  Windows("Shipping formula-1.xlsm").Activate
    Sheets("Signed").Select
    ActiveSheet.Shapes.Range(Array("Picture 4")).Select
    Selection.Copy
作者: GBKEE    時間: 2012-10-10 08:45

回復 4# PJChen
附檔看看
作者: PJChen    時間: 2012-10-12 17:17

回復 5# GBKEE

大大,

我將簽名檔更換後,不會出現錯誤訊息,但仍會亂貼,我是先錄製巨集,得知簽名檔各自的Picture代號各自為1 & 7,但奇怪的是,它不會依我指定的代號去貼,貼上的都是7的代號,更令我不解的是,原先代號7尚未出現時,一切都沒有異常發生.
[attach]12757[/attach]
作者: Hsieh    時間: 2012-10-12 17:54

回復 6# PJChen

執行以下代碼就知道了
  1. Sub nn()
  2. For Each pic In 工作表8.Pictures
  3. MsgBox pic.Index
  4. MsgBox pic.Name
  5. Next
  6. End Sub
複製代碼
作者: GBKEE    時間: 2012-10-12 18:12

回復 6# PJChen
可得正確 圖片名稱
  1. Sub try()
  2.   Dim S As Picture
  3.   For Each S In Workbooks("Shipping formula-2.xlsm").Sheets("Signed").Pictures
  4.      S.TopLeftCell.Offset(-1) = S.Name
  5.   Next
  6. End Sub
複製代碼
作者: PJChen    時間: 2012-10-12 22:37

回復 7# Hsieh

大大,
執行程式後會出現對話框並且顯示數字,還有Picture#,但無法知道哪個代號與哪個簽名檔是配在一起的!
另外就是只有二個簽名,可是為什麼對話框出現4次?
作者: PJChen    時間: 2012-10-12 22:43

回復 8# GBKEE

G大,
執行程式後,會在簽名檔上出現相應的Picture代碼,這證實我原先設的代碼也沒錯,可是會亂貼的原因是什麼?是否二個貼簽名的程式有衝突的地方?導致亂貼簽名檔?
另外想請教每放一個簽名檔都會自動產生它自己的代號,但代號是否可以更改?

[attach]12758[/attach]
作者: Hsieh    時間: 2012-10-12 22:53

本帖最後由 Hsieh 於 2012-10-12 23:05 編輯

回復 9# PJChen
  1. Sub nn()
  2. For Each pic In 工作表8.Pictures
  3. MsgBox "圖片的序號  " & pic.Index '圖片的序號
  4. MsgBox "圖片的名稱  " & pic.Name  '圖片的名稱
  5. Next
  6. End Sub
複製代碼
妳的程式碼中try程序使用Pictures(1).Copy這會指定圖片序號
try_2程序使用Pictures("Picture 7").Select這會指定圖片名稱
[attach]12759[/attach]
作者: PJChen    時間: 2012-10-12 23:58

回復 11# Hsieh

大大,

指定圖片序號 or 指定圖片名稱 有什麼不同嗎?這二個簽名,一個是Picture 1,一個是Picture 7,問題在於我指定了,但會亂貼,我該如何修正程式嗎?
作者: PJChen    時間: 2012-10-13 00:06

回復 11# Hsieh

補充:
如果我想以"指定圖片名稱"來寫程式,它並不接受.
Workbooks("Shipping formula-2.xlsm").Sheets("Signed")."Picture 1".Copy
作者: Hsieh    時間: 2012-10-13 00:34

本帖最後由 Hsieh 於 2012-10-13 00:37 編輯

回復 13# PJChen

Workbooks("Shipping formula-2.xlsm").Sheets("Signed").Pictures("Picture 1").Copy
這是指定名稱的寫法
這類工作我會建議圖檔直接貼入不需將圖片先放在工作表再去複製
做一個簡單範例妳參考看看
   [attach]12760[/attach]
作者: PJChen    時間: 2012-10-13 01:01

回復 14# Hsieh

Hsieh大大,

謝謝幫我修改的程式,已經可以執行了!
因工作上需要放的簽名檔太多了,所以才想讓它自動放上簽名,這樣真的方便許多!感謝!
作者: PJChen    時間: 2012-10-13 01:33

回復 2# GBKEE

大大,

請問這個程式若改為只貼在一個sheet( INV),而不是貼3個sheet, 我將他改為以下,雖可以執行,但原先你幫我寫的是陣列,現在改這樣好像有點複雜化了,我可以怎麼修正呢?
   Dim Rng(1 To 1) As Range, xi As Integer
    Workbooks("Shipping formula.xlsm").Sheets("Signed").Pictures("Picture 1").Copy
    With Workbooks("Shipping for Courier.xlsx")
        .Activate
        Set Rng(1) = .Sheets("INV").[R:R].Find("B. C. MART COMPANY LTD.").Offset(3, 0)
        For xi = 1 To 1
            Rng(xi).Parent.Activate
            Rng(xi).Activate
            ActiveSheet.Paste
        Next
    End With
作者: GBKEE    時間: 2012-10-13 07:36

回復 10# PJChen
試試看
  1. Sub try()  '每一個簽名檔都可以改它自己的代號 ( Name ,名稱)
  2.     Dim Rng(1 To 3) As Range, xi As Integer
  3.     With Workbooks("Shipping formula-2.xlsm").Sheets("Signed")
  4.         For xi = 1 To .Pictures.Count
  5.             .Pictures(xi).Name = "簽名" & xi
  6.         Next
  7.         .Pictures("簽名1").Copy '.Pictures("簽名2").Copy
  8.     End With
  9.     With Workbooks("Shipping for ACE.xlsx")
  10.         Set Rng(1) = .Sheets("PKG").[R:R].Find("B. C. MART COMPANY LTD.", LOOKAT:=xlPart).Offset(2, -2)
  11.         Set Rng(2) = .Sheets("INV").[Q:Q].Find("B. C. MART COMPANY LTD.").Offset(2, -2)
  12.         Set Rng(3) = .Sheets("SCD").[B:B].Find("Signature:").Offset(0, 1)
  13.         For xi = 1 To 3
  14.             Rng(xi).Parent.Pictures.Delete  '刪除 Rng(xi)父層(工作表)的圖片
  15.             Rng(xi).PasteSpecial
  16.         Next
  17.     End With
  18. End Sub
複製代碼
作者: GBKEE    時間: 2012-10-13 07:53

回復 4# PJChen

http://forum.twbts.com/viewthread.php?tid=8016&rpid=45083&ordertype=0&page=2#pid45083
作者: PJChen    時間: 2012-10-13 11:59

回復 16# GBKEE

大大,

請教我想將更改圖片名稱與貼簽名的程式分開,因為更改圖片名稱只要進行一次即可,而更改後的簽名卻是有許多程式要共用的.我把它改為以下,不知哪出錯了,無法運作?

Sub change_Signed()
    'Dim Rng(1 To 3) As Range, xi As Integer
    With Workbooks("Shipping formula-2.xlsm").Sheets("Signed")
        For xi = 1 To .Pictures.Count
            .Pictures(xi).Name = "簽名" & xi
        Next
    End With
            Rng(xi).Parent.Pictures.Delete  '刪除 Rng(xi)父層(工作表)的圖片
            Rng(xi).PasteSpecial
End Sub
作者: PJChen    時間: 2012-10-13 12:10

回復 5# GBKEE

大大,
您回覆的連結是改圖片名稱及貼簽名至3個工作表,但我只要貼1個簽名,現在我把它改為以下,但無法運作,可以幫忙看看嗎?

Sub try()
    Dim Rng As Range
    Workbooks("Shipping formula.xlsm").Sheets("Signed").Pictures("簽名2").Copy
    With Workbooks("Shipping for Courier.xlsx")
        .Activate
    Set Rng = .Sheets("PKG").[D:D].Find("TOTAL N. W.", LOOKAT:=xlPart).Offset(0, 11)
    If Not Rng Is Nothing Then
        With Rng
            .Parent.Activate   'Worksheet
            .Activate       'Range
        End With
        ActiveSheet.Paste
    End If
    End With
End Sub
作者: GBKEE    時間: 2012-10-13 13:14

回復 6# PJChen
語法 都正確 運作正常
無法運作   請說是哪裡出錯!
作者: GBKEE    時間: 2012-10-13 13:20

回復 17# PJChen
  1. Sub change_Signed()
  2.     Dim Rng(1 To 3) As Range, xi As Integer
  3.     With Workbooks("Shipping formula-2.xlsm").Sheets("Signed")
  4.         For xi = 1 To .Pictures.Count
  5.             .Pictures(xi).Name = "簽名" & xi
  6.         Next
  7.     End With
  8.     MsgBox xi ' 這時 xi=.Pictures.Count + 1 超出 Rng的索引值
  9.     Rng(xi).Parent.Pictures.Delete  '刪除 Rng(xi)父層(工作表)的圖片
  10.     Rng(xi).PasteSpecial
  11. End Sub
複製代碼
作者: PJChen    時間: 2012-10-13 13:41

回復 18# GBKEE

大大,

執行後出現3的對話框,然後就無法運作,到巨集程式中,看見以下的字框起來了.
   Rng(xi).Parent.Pictures.Delete  '刪除 Rng(xi)父層(工作表)的圖片
作者: PJChen    時間: 2012-10-13 13:48

回復 7# GBKEE

大大,

我將程式整理進案例中了,請幫忙看看: [attach]12762[/attach]
作者: GBKEE    時間: 2012-10-13 15:46

回復 19# PJChen
執行後出現3的對話框,然後 Rng(xi).Parent.Pictures.Delete 就無法運作
MsgBox xi ' 這時 xi=.Pictures.Count + 1      xi 已是 3
可是程式碼  沒看到 SET Rng(xi)=??    所以會出錯
作者: PJChen    時間: 2012-10-13 15:54

回復 20# GBKEE

大大,

我只是將你寫的程式套進去而已,你回覆給我的,其實我一點都不明白,可否幫忙修改原程式?
作者: GBKEE    時間: 2012-10-13 16:22

回復 8# PJChen
  1. Sub 貼簽名()   '先執行此程式
  2. With Workbooks("Shipping formula-2.xlsm").Sheets("Signed")
  3.         For xi = 1 To .Pictures.Count
  4.             .Pictures(xi).Name = "簽名" & xi
  5.         Next
  6.     End With
  7. End Sub
  8. Sub try_2()   '後執行此程式
  9.     Dim Rng As Range
  10.     Windows("Shipping formula-2.xlsm").Activate
  11.     Sheets("Signed").Select
  12.     ActiveSheet.Shapes.Range(Array("簽名1")).Select
  13.     Selection.Copy
  14.     Set Rng = Workbooks("Accounting_Rising.xlsx").Sheets("INV").[P:P].Find("RISING STAR COMPANY LTD.").Offset(2, 0)
  15.     If Not Rng Is Nothing Then
  16.         With Rng
  17.             .Parent.Activate   'Worksheet
  18.             .Activate       'Range
  19.         End With
  20.         ActiveSheet.Paste
  21.     End If
  22. End Sub
複製代碼
作者: PJChen    時間: 2012-10-13 17:14

回復 30# GBKEE

大大,

1) 我已將新程式修改好了,但更改圖片名稱的程式仍無法執行....[attach]12764[/attach]
2) 貼簽名的程式執行ok.
作者: GBKEE    時間: 2012-10-13 19:05

回復 31# PJChen
這程式嗎? 在2003版執行沒問題
  1. Sub change_Signed()
  2. With Workbooks("Shipping formula-2.xlsm").Sheets("Signed")
  3.         For xi = 1 To .Pictures.Count
  4.             .Pictures(xi).Name = "簽名" & xi
  5.         Next
  6.     End With
  7. End Sub
複製代碼
作者: PJChen    時間: 2012-10-13 19:40

回復 32# GBKEE
大大,

請問在2010版有無法方可修改,讓它可運作?
作者: GBKEE    時間: 2012-10-14 07:35

回復 33# PJChen
那須有高於2003版本者來解了
作者: PJChen    時間: 2012-10-14 11:08

回復 34# GBKEE

Dear,

若有人使用2010版本的Excel,可否幫忙修改31樓的變更圖片名稱的程式?
作者: Hsieh    時間: 2012-10-14 11:25

回復 35# PJChen

更名程式並沒錯誤啊!
不知道你是如何執行
上傳的檔案確實可以執行
作者: PJChen    時間: 2012-10-14 13:27

回復 36# Hsieh
大大,

我了解了,是我自己犯的錯誤,確實可以執行.



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