1234
返回列表 上一主題 發帖

[發問] 巨集陣列的程式

PJChen
　暱稱: PJ

高中生Rank: 3Rank: 3

帖子
640 
主題
108 
精華
0 
積分
774 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2020-2-22 

論壇榮譽勳章論壇贊助勳章
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格

請問我該怎麼做?
收藏 分享

GBKEE

帖子
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
  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

PJChen
　暱稱: PJ

高中生Rank: 3Rank: 3

帖子
640 
主題
108 
精華
0 
積分
774 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2020-2-22 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2012-4-29 09:49 | 只看該作者
回復 2# GBKEE

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

TOP

PJChen
　暱稱: PJ

高中生Rank: 3Rank: 3

帖子
640 
主題
108 
精華
0 
積分
774 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2020-2-22 

論壇榮譽勳章論壇贊助勳章
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

帖子
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
試試看
  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

PJChen
　暱稱: PJ

高中生Rank: 3Rank: 3

帖子
640 
主題
108 
精華
0 
積分
774 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2020-2-22 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2012-10-9 15:34 | 只看該作者
回復 2# GBKEE

感謝大大, ok了!

TOP

PJChen
　暱稱: PJ

高中生Rank: 3Rank: 3

帖子
640 
主題
108 
精華
0 
積分
774 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2020-2-22 

論壇榮譽勳章論壇贊助勳章
7#
發表於 2012-10-9 21:12 | 只看該作者
回復 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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2012-10-10 08:45 | 只看該作者
回復 4# PJChen
附檔看看

TOP

PJChen
　暱稱: PJ

高中生Rank: 3Rank: 3

帖子
640 
主題
108 
精華
0 
積分
774 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2020-2-22 

論壇榮譽勳章論壇贊助勳章
9#
發表於 2012-10-12 17:17 | 只看該作者
回復 5# GBKEE

大大,

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

TOP

Hsieh

帖子
4898 
主題
44 
精華
24 
積分
4913 
點名
49  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2020-2-22 

2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 甘願做、歡喜受。
1234
返回列表 上一主題