返回列表 上一主題 發帖

[發問] 巨集陣列的程式

[發問] 巨集陣列的程式

各位好,

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

請問我該怎麼做?

回復 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
複製代碼

TOP

回復 2# GBKEE

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

TOP

貼簽名檔

請教各位大大:

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

TOP

回復 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
複製代碼

TOP

回復 2# GBKEE

感謝大大, ok了!

TOP

回復 2# GBKEE

請問大大,
以下二種不同的寫法,會造成錯誤嗎?
我新增了 2)的簽名後,其他如1)的簽名檔,不是亂貼簽名2)的簽名,就是出現錯誤訊息!  
ERR.jpg
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

TOP

回復 4# PJChen
附檔看看

TOP

回復 5# GBKEE

大大,

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

TOP

回復 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
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始,每一個時刻都是自己的警惕。
返回列表 上一主題