返回列表 上一主題 發帖

[發問] 巨集陣列的程式

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

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

回復 4# PJChen
附檔看看

TOP

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

TOP

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

TOP

TOP

回復 6# PJChen
語法 都正確 運作正常
無法運作   請說是哪裡出錯!

TOP

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

TOP

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

TOP

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

TOP

        靜思自在 : 一個人不怕錯,就怕不改過,改過並不難。
返回列表 上一主題