PJChen

　暱稱: PJ

帖子: 569
主題: 95
精華: 0
積分: 690
點名: 3
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2019-11-21

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 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格

請問我該怎麼做?

樓主熱帖

Dreamweaver CC 資料庫網頁實例應用：零程式基礎輕鬆製作PHP資料庫網頁

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5894
主題: 13
精華: 1
積分: 5952
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2019-9-21

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2012-4-29 07:28 | 只看該作者

回復 1# PJChen

Sub Ex()
Dim Rng(1 To 3) As Range, xi As Integer
Workbooks("Shipping formula.xlsm").Sheets("Signed").Pictures(1).Copy
With Workbooks("Shipping for ACE.xlsx")
.Activate
Set Rng(1) = .Sheets("PKG").[D:D].Find("TOTAL N. W.", LOOKAT:=xlPart).Offset(0, 12)
Set Rng(2) = .Sheets("INV").[Q:Q].Find("B. C. MART COMPANY LTD.").Offset(2, 0)
Set Rng(3) = .Sheets("SCD").[B:B].Find("Signature:").Offset(0, 2)
For xi = 1 To 3
Rng(xi).Parent.Activate
Rng(xi).Activate
ActiveSheet.Paste
Next
End With
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

高中生 Rank: 3 Rank: 3

帖子: 569
主題: 95
精華: 0
積分: 690
點名: 3
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2019-11-21

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2012-4-29 09:49 | 只看該作者

回復 2# GBKEE

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

TOP

PJChen

　暱稱: PJ

高中生 Rank: 3 Rank: 3

帖子: 569
主題: 95
精華: 0
積分: 690
點名: 3
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2019-11-21

論壇榮譽勳章論壇贊助勳章

4^#

發表於 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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5894
主題: 13
精華: 1
積分: 5952
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2019-9-21

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2012-10-9 14:54 | 只看該作者

回復 1# PJChen
試試看

Option Explicit
Sub Ex()
Dim Rng As Range
Windows("Shipping formula.xlsm").Activate
Sheets("Signed").Select
ActiveSheet.Shapes.Range(Array("Picture 6")).Select
Selection.Copy
Set Rng = Workbooks("Accounting_Rising.xlsx").Sheets("INV").[P:P].Find("RISING STAR COMPANY LTD.").Offset(2, 0)
If Not Rng Is Nothing Then
With Rng
.Parent.Activate 'Worksheet
.Activate 'Range
End With
ActiveSheet.Paste
End If
End Sub

複製代碼

TOP

PJChen

　暱稱: PJ

高中生 Rank: 3 Rank: 3

帖子: 569
主題: 95
精華: 0
積分: 690
點名: 3
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2019-11-21

論壇榮譽勳章論壇贊助勳章

6^#

發表於 2012-10-9 15:34 | 只看該作者

回復 2# GBKEE

感謝大大, ok了!

TOP

PJChen

　暱稱: PJ

高中生 Rank: 3 Rank: 3

帖子: 569
主題: 95
精華: 0
積分: 690
點名: 3
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2019-11-21

論壇榮譽勳章論壇贊助勳章

7^#

發表於 2012-10-9 21:12 | 只看該作者

回復 2# GBKEE

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

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

GBKEE