1234567
返回列表 上一主題 發帖

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

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
11# 跳轉到 »
發表於 2015-5-5 23:18 | 只看該作者
回復 10# lpk187
感謝幫忙~使用上方指令讀取 Q2用cell(filename)叫出來的路徑不知為何會參照錯誤
所以我只使用到 Address:=ThisWorkbook.Name  這樣也能達成我想要的效果(如下方代碼)

另想再知道如何在
以下這代碼中 插入這串自動在最下方空白列貼上的指令呢
      EndRow = ActiveSheet.UsedRange.Rows.Count + 1 '所有使用中的列數+1
    Rows(EndRow).PasteSpecial Paste:=xlPasteValues'目前使用中的分頁,的最下方空白列貼上值

因如果把Range("B7").Select拿掉,變成是以我滑鼠點選的儲值格為開頭去貼上
如果要他讓他以A1.A2.A3.A4這樣自動依序往下貼上不知該如何更改呢
  1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
  2. '
  3. ' 貼上資料至_業務管理 巨集
  4. '

  6. '
  7.     Range("A3:P3").Select
  8.     Selection.Copy
  9.     Windows("客戶明細-業務專用.xlsm").Activate
  10.     Range("B7").Select
  11.     ActiveSheet.Paste Link:=True
  12.     Windows("客戶明細-業務專用.xlsm").Activate
  13.     ActiveSheet.Paste Link:=True
  14.     Application.CutCopyMode = False
  15.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ThisWorkbook.Name

  17. End Sub
複製代碼

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
12#
發表於 2015-5-6 08:15 | 只看該作者
本帖最後由 starry1314 於 2015-5-6 08:25 編輯

回復 11# starry1314

不知&!Q2是要怎麼修正呢,
狀況:
1.參照路徑會錯誤,
2.也會在業務明細新貼上業務明細的檔案路徑

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
13#
發表於 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-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
14#
發表於 2015-5-6 08:30 | 只看該作者
回復 12# starry1314


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

a.png (49.26 KB)

a.png

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
15#
發表於 2015-5-6 08:39 | 只看該作者
本帖最後由 starry1314 於 2015-5-6 08:40 編輯

回復 14# lpk187

了解~那
EndRow = Windows("客戶明細-業務專用.xlsm").ActiveSheet.Range("b4", Cells(Rows.Count, "A").End(xlUp).Address).Row + 1 '所有使用中的列數+1
   
假如B4,B5已有資料~他會變成在業務專用的B5的位置覆蓋 不會跑到B6去呢
應該是Range("b4",    讓他一直重B4+1吧?
所以我將它拿掉改成
EndRow = Windows("客戶明細-業務專用.xlsm").ActiveSheet.Range( Cells(Rows.Count, "A").End(xlUp).Address).Row + 1 '所有使用中的列數+1
即可以自動往下了
但不知為何如果點擊超連結之後跳回 個別客戶明細都會參照錯誤...

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
16#
發表於 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-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
17#
發表於 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-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
18#
發表於 2015-5-6 08:56 | 只看該作者
回復 16# lpk187

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

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
19#
發表於 2015-5-6 08:58 | 只看該作者
1.Sheets("五月")<請問關於妳所說的變數
假如在個別客戶明細(Q3)做一個清單 一~十二月,那有什麼指令可以讓"五月" 去讀取那個位置變成動態呢?  cells(Q3) 這樣嗎?

Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm")
因客戶明細-業務專用.xlsm會有好幾個業務的,如 \\..\..\..\..\業務專用   內有不同業務的資料夾,再下一層才會是客戶明細-業務專用.xlsm

所以可以用
Workbooks.Open (" \\..\..\..\..\業務專用" &"不同業務的資料夾(依O3內容的名稱變更)"& "\" & "客戶明細-業務專用.xlsm")

如業務專用(複製路徑)," &"業務-張,  "& "\" & "客戶明細-業務專用.xlsm"  像這樣可以達成嗎

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
20#
發表於 2015-5-6 09:08 | 只看該作者
回復 18# lpk187


點擊超連結後   參照路徑錯誤的問題知道哪邊出問題了
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ThisWorkbook.Path & "\" & ThisWorkbook.Name, SubAddress:=ActiveSheet.Name

SubAddress:=ActiveSheet.Name     '導致業務明細的超連結會讀取業務明細的目前工作頁名稱,  變成 個別客戶明細(超連結)-五月'

TOP

        靜思自在 : 人的心地是一畦田，土地沒有播下好種子，也長不出好的果實。 -
1234567
返回列表 上一主題