GBKEE

回復 4# PJChen

http://forum.twbts.com/viewthread.php?tid=8016&rpid=45083&ordertype=0&page=2#pid45083

PJChen

回復 16# GBKEE

大大,

請教我想將更改圖片名稱與貼簽名的程式分開,因為更改圖片名稱只要進行一次即可,而更改後的簽名卻是有許多程式要共用的.我把它改為以下,不知哪出錯了,無法運作?

Sub change_Signed()
    'Dim Rng(1 To 3) As Range, xi As Integer
    With Workbooks("Shipping formula-2.xlsm").Sheets("Signed")
        For xi = 1 To .Pictures.Count
            .Pictures(xi).Name = "簽名" & xi
        Next
    End With
            Rng(xi).Parent.Pictures.Delete  '刪除 Rng(xi)父層(工作表)的圖片
            Rng(xi).PasteSpecial
End Sub

PJChen

回復 5# GBKEE

大大,
您回覆的連結是改圖片名稱及貼簽名至3個工作表,但我只要貼1個簽名,現在我把它改為以下,但無法運作,可以幫忙看看嗎?

Sub try()
    Dim Rng As Range
    Workbooks("Shipping formula.xlsm").Sheets("Signed").Pictures("簽名2").Copy
    With Workbooks("Shipping for Courier.xlsx")
        .Activate
    Set Rng = .Sheets("PKG").[D:D].Find("TOTAL N. W.", LOOKAT:=xlPart).Offset(0, 11)
    If Not Rng Is Nothing Then
        With Rng
            .Parent.Activate   'Worksheet
            .Activate       'Range
        End With
        ActiveSheet.Paste
    End If
    End With
End Sub

GBKEE

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

GBKEE

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

複製代碼

PJChen

回復 18# GBKEE

大大,

執行後出現3的對話框,然後就無法運作,到巨集程式中,看見以下的字框起來了.
   Rng(xi).Parent.Pictures.Delete  '刪除 Rng(xi)父層(工作表)的圖片

PJChen

回復 7# GBKEE

大大,

我將程式整理進案例中了,請幫忙看看: Shipping formula-2.zip (111.39 KB)

下載次數: 4

2012-10-13 13:48

GBKEE

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

PJChen

回復 20# GBKEE

大大,

我只是將你寫的程式套進去而已,你回覆給我的,其實我一點都不明白,可否幫忙修改原程式?

GBKEE

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

複製代碼