[發問] 巨集陣列的程式

PJChen

各位好,

我想寫一個巨集陣列的程式,條件如下:
從工作表"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

回復 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

回復 2# GBKEE

G版大,
謝謝您,進行很順利.

PJChen

請教各位大大:

簽名檔"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

回復 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

回復 2# GBKEE

感謝大大, ok了!

PJChen

回復 2# GBKEE

請問大大,
以下二種不同的寫法,會造成錯誤嗎?
我新增了 2)的簽名後,其他如1)的簽名檔,不是亂貼簽名2)的簽名,就是出現錯誤訊息!  

下載 (18.01 KB)

2012-10-9 21:12

    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

回復 4# PJChen
附檔看看

PJChen

回復 5# GBKEE

大大,

我將簽名檔更換後,不會出現錯誤訊息,但仍會亂貼,我是先錄製巨集,得知簽名檔各自的Picture代號各自為1 & 7,但奇怪的是,它不會依我指定的代號去貼,貼上的都是7的代號,更令我不解的是,原先代號7尚未出現時,一切都沒有異常發生.
Shipping formula-2.zip (106.25 KB)

下載次數: 4

2012-10-12 17:16

Hsieh

回復 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

複製代碼