巨集陣列的程式 - Excel程式區 - 麻辣家族討論版版

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

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

11^# 跳轉到 »

發表於 2012-10-13 01:01 | 顯示全部帖子

回復 14# Hsieh

Hsieh大大,

謝謝幫我修改的程式,已經可以執行了!
因工作上需要放的簽名檔太多了,所以才想讓它自動放上簽名,這樣真的方便許多!感謝!

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

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

12^#

發表於 2012-10-13 01:33 | 顯示全部帖子

回復 2# GBKEE

大大,

請問這個程式若改為只貼在一個sheet( INV),而不是貼3個sheet, 我將他改為以下,雖可以執行,但原先你幫我寫的是陣列,現在改這樣好像有點複雜化了,我可以怎麼修正呢?
Dim Rng(1 To 1) As Range, xi As Integer
Workbooks("Shipping formula.xlsm").Sheets("Signed").Pictures("Picture 1").Copy
With Workbooks("Shipping for Courier.xlsx")
      .Activate
      Set Rng(1) = .Sheets("INV").[R:R].Find("B. C. MART COMPANY LTD.").Offset(3, 0)
      For xi = 1 To 1
         Rng(xi).Parent.Activate
         Rng(xi).Activate
         ActiveSheet.Paste
      Next
End With

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

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

13^#

發表於 2012-10-13 11:59 | 顯示全部帖子

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

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

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

14^#

發表於 2012-10-13 12:10 | 顯示全部帖子

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

TOP

PJChen