12
返回列表 上一主題 發帖

[發問] 關於自動貼上連結至另一個檔案並自動插入超連結

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 2015-5-5 22:01 | 顯示全部帖子
回復 2# starry1314


    看不懂你的連結是要連到哪裡，
像這樣嗎？
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="客戶明細-業務專用.xlsm", SubAddress:="五月!A1"

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 2015-5-5 22:09 | 顯示全部帖子
回復 2# starry1314


    還是這樣？
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="個別客戶明細(請先另存新檔).xlsm", SubAddress:="收款跟催!Q2"

還有你的連結要放哪裡？你的問題中也沒說清楚！所以我只能猜測

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2015-5-5 22:41 | 顯示全部帖子
本帖最後由 lpk187 於 2015-5-5 22:46 編輯

回復 6# starry1314


    Windows("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add Anchor:=Windows("客戶明細-業務專用.xlsm").Sheets("五月").Range("B7"), Address:=ThisWorkbook.Name, SubAddress:=ActiveSheet.Name & "!Q2"
其中 ThisWorkbook.Name 是"取得"個別客戶的工作簿名稱
ActiveSheet.Name是目前的工作表名稱
會用這2個是你說個別客戶的工作簿名稱會不同所以可以用這樣來讀取其名稱

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
4#
發表於 2015-5-5 22:50 | 顯示全部帖子
回復 7# starry1314


    若要再讀取路徑可用ThisWorkbook.Path & "\" & ThisWorkbook.Name
所以可以這樣 Address:=ThisWorkbook.Path & "\" & ThisWorkbook.Name, SubAddress:=ActiveSheet.Name & "!Q2"

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
5#
發表於 2015-5-6 08:24 | 顯示全部帖子
回復 12# starry1314
  1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
  2. '
  3. ' 貼上資料至_業務管理 巨集
  4. '

  6. '
  7.    
  8.    
  9.     Range("A3:P3").Copy
  10.     Workbooks.Open (ThisWorkbook.Path & "\" & "客戶明細-業務專用.xlsm")
  11.     Windows("客戶明細-業務專用.xlsm").Activate
  12.     EndRow = Windows("客戶明細-業務專用.xlsm").Sheets("五月").Range("B4", Cells(Rows.Count, "B").End(xlUp).Address).Row + 1 '所有使用中的列數+1
  13.     Windows("客戶明細-業務專用.xlsm").Sheets("五月").Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '目前使用中的分頁,的最下方空白列貼上值
  14.     ActiveSheet.Paste Link:=True
  15.     Windows("客戶明細-業務專用.xlsm").Activate
  16.     ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name
  17.     Workbooks("客戶明細-業務專用.xlsm").Close True

  19. End Sub
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2015-5-6 08:30 | 顯示全部帖子
回復 12# starry1314


    路徑的問題，若要用網路磁碟機那路徑就要設絕對路徑給它
如下圖把路徑複製起來然後  Address:="複製的路徑" & "\" & ThisWorkbook.Name

a.png (49.26 KB)

a.png

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
7#
發表於 2015-5-6 08:43 | 顯示全部帖子
本帖最後由 lpk187 於 2015-5-6 08:44 編輯

回復 12# starry1314


    程序修改如下
  1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
  2. '
  3. ' 貼上資料至_業務管理 巨集
  4. '

  6. '
  7.    
  8.    
  9.     Range("A3:P3").Copy
  10.     Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm")
  11.     Windows("客戶明細-業務專用.xlsm").Activate
  12.     EndRow = Windows("客戶明細-業務專用.xlsm").Sheets("五月").Range("B4", Cells(Rows.Count, "B").End(xlUp).Address).Row + 1 '所有使用中的列數+1
  13.     Windows("客戶明細-業務專用.xlsm").Sheets("五月").Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '目前使用中的分頁,的最下方空白列貼上值
  14.     ActiveSheet.Paste Link:=True
  15.     Windows("客戶明細-業務專用.xlsm").Activate
  16.     ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:="複製的路徑" & "\" & ThisWorkbook.Name
  17.     Workbooks("客戶明細-業務專用.xlsm").Close True

  19. End Sub
複製代碼
其中的Sheets("五月")，你可以用變數來讓它變成動態的，或是讓使用者自己選擇，也或是依照日期來選擇，方法有很多，
還有ActiveSheet也可以用Sheets("五月")的變數取代之
連 Range("A3:P3").Copy這個也可以讓它成為變數
在程式中除非必要，否則盡量不要用.Select或.Activate，因為這樣產生的bug也會很多的，而且動作也會變慢！

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
8#
發表於 2015-5-6 08:48 | 顯示全部帖子
回復 15# starry1314


    ActiveSheet.Range("b4", Cells(Rows.Count, "A").End(xlUp).Address).Row + 1
這句的意思是從居b4開始到B欄的最後儲存格然後再加1為下一個儲存格

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 2015-5-6 08:56 | 顯示全部帖子
回復 16# lpk187

語法錯誤應該是這樣才對
    EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
10#
發表於 2015-5-6 09:28 | 顯示全部帖子
本帖最後由 lpk187 於 2015-5-6 09:30 編輯

回復 20# starry1314
  1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
  2. '
  3. ' 貼上資料至_業務管理 巨集

  5.     'Range("A3:P3").Copy
  6.     sht = ActiveSheet.Name
  7.     arr = Range("A3:P3")
  8.     本檔案的路徑 = ThisWorkbook.Path & "\"
  9.     本檔案的檔名 = ThisWorkbook.Name
  10.    
  11.     Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm") '這裡的"複製的路徑"是要可以開"客戶明細-業務專用.xlsm"的路徑
  12.     Windows("客戶明細-業務專用.xlsm").Activate
  13.     AA = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Address
  14.     EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
  15.     'Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '原本的程序
  16.     Cells(EndRow, "B").Resize(1, UBound(arr, 2)) = Application.Transpose(Application.Transpose(arr)) '目前使用中的分頁,的最下方空白列貼上值
  17.     'ActiveSheet.Paste Link:=True
  18.     Windows("客戶明細-業務專用.xlsm").Activate
  19.     'ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name, SubAddress:=sht'原本的程序
  20.     Windows("客戶明細-業務專用.xlsm").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的路徑 & ThisWorkbook.Name, SubAddress:=sht變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
  21.     Workbooks("客戶明細-業務專用.xlsm").Close True

  23. End Sub
複製代碼
上面是我有修改的程序，其中有解釋路徑

TOP

        靜思自在 : 慈悲沒有敵人，智慧不起煩惱。
12
返回列表 上一主題