1234567
返回列表 上一主題 發帖

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

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-5-5 16:57 | 只看該作者

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

本帖最後由 starry1314 於 2015-5-5 17:02 編輯

請問像以下指令如何將
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "..\..\業務\業務明細.xlsm"   這串的address寫成

疑問Q1:我在Q3儲存格使用 CELL(filrname)叫出來的檔案名稱路徑呢?  原本地址是設定好的 想讓他隨著檔案的變動也跟著變動
        Q2:如何在這些指令插入 EndRow = ActiveSheet.UsedRange.Rows.Count + 1 '所有使用中的列數+1 這條指令呢

想讓他在所有使用中列數+1並且可插入超連結

範例-自動插入超連結.rar (277.7 KB)
  1. Sub 貼上資料至_業務管理()
  2. '
  3. ' 貼上資料至_業務管理 巨集
  4. '
  5.     Range("A3:P3").Select
  6.     Selection.Copy
  7.     Windows("客戶明細-業務專用.xlsm").Activate
  8.     Range("B7").Select
  9.     ActiveSheet.Paste Link:=True
  10.     Windows("客戶明細-業務專用.xlsm").Activate
  11.     ActiveSheet.Paste Link:=True
  12.     Application.CutCopyMode = False
  13.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
  14.         "..\..\業務\業務明細.xlsm"

  16. End Sub
複製代碼

收藏 分享

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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


   
感謝..原來是少了sheets
原本寫法...ThisWorkbook.Activate

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
65#
發表於 2015-5-25 09:34 | 只看該作者
本帖最後由 lpk187 於 2015-5-25 09:38 編輯

回復 64# starry1314


    我不知道你原活頁簿的工作表名稱是什麼，我假設它是"出餐單"這的工作表
ThisWorkbook.Sheets("出餐單").Activate
"ThisWorkbook"是原程式所在的活頁簿

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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


    L大~想請問一下
要怎麼最後一行加入windows指令可讓他返回巨集所存在的視窗,或是在哪裡點擊巨集就跳轉回來
  1.     Sheets("數據").Select
  2.     Range("B27").Select
  3.     Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  4.     Sheets("快速輸入").Select
  5.     Range("B2") = "=" & ThisWorkbook.Sheets("出餐單").Range("H1").Address(, , , 1)
  6.     Range("C3") = "=" & ThisWorkbook.Sheets("出餐單").Range("C5").Address(, , , 1)
  7.     Range("D3") = "=" & ThisWorkbook.Sheets("出餐單").Range("L1").Address(, , , 1)
  8.     Range("B4") = "=" & ThisWorkbook.Sheets("出餐單").Range("B3").Address(, , , 1)
  9.     Range("B5") = "=" & ThisWorkbook.Sheets("出餐單").Range("E1").Address(, , , 1)
複製代碼

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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

感謝說明~我再試試看！

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
62#
發表於 2015-5-12 15:37 | 只看該作者
本帖最後由 GBKEE 於 2015-5-12 15:41 編輯

回復 60# starry1314

  1. Sub Ex()
  2.     End
  3.     '當執行到 End 陳述式時，陳述式會重新設定在所有模組中的所有模組層次變數以及所有靜態區域變數。
  4.     '若要保留這些變數的值，請使用 Stop 陳述式來取代 End ，然後您可以在稍後繼續執行。
  5. End Sub
複製代碼
模組共用的私用變數執行後會存在於 VBA中
若有執行 End 陳述式
或如圖的 重新設定
變數需再度設定
也就是說
給你的 Sub Main()須執行一次,
給你的 Sub Ex() 才沒有錯誤的
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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


    目前改為以下指令,已解決連結問題,
  1. Sub 小餐單_A餐_自動輸入資料()
  2.     Sheets("數據").Select
  3.     Range("B22").Select
  4.     Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  5.     Sheets("快速輸入").Select
  6.     Range("B2") = "=" & ThisWorkbook.Sheets("出餐單").Range("H1").Address(, , , 1)
  7.     Range("C3") = "=" & ThisWorkbook.Sheets("出餐單").Range("C4").Address(, , , 1)
  8.     Range("D3") = "=" & ThisWorkbook.Sheets("出餐單").Range("V1").Address(, , , 1)
  9.     Range("B4") = "=" & ThisWorkbook.Sheets("出餐單").Range("X3").Address(, , , 1)
  10.     Range("B5") = "=" & ThisWorkbook.Sheets("出餐單").Range("E1").Address(, , , 1)
  11. End Sub
複製代碼

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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


   版主大大~不好意思  使用F8逐行執行時
WbSh(1). 會跳出沒有定義這個SUB或function
但看上方MANI指令中就已有定義..請問是哪邊不對呢...
Sub Ex()

    WbSh(1).Range("B22").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    With WbSh(3) '不必 Select來 Select去
        .Range("B2") = "=" & WbSh(2).Range("H1").Address(, , , 1)
            '用公式連結
        .Range("C3") = "=" & WbSh(2).Range("C4").Address(, , , 1)
        .Range("D3") = "=" & WbSh(2).Range("V1").Address(, , , 1)
        .Range("B4") = "=" & WbSh(2).Range("X3").Address(, , , 1)
        .Range("B5") = "=" & WbSh(2).Range("E1").Address(, , , 1)
    End With
End Sub

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
59#
發表於 2015-5-11 19:28 | 只看該作者
呵呵呵！版主大大太強了，說真的當初我沒看到
ActiveSheet.Paste Link:=True這行
還再想怎麼回starry1314這個程式碼，版主大大就出手相助，這程式碼也讓我受易良多

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
58#
發表於 2015-5-11 16:01 | 只看該作者
回復 57# starry1314
  1. Option Explicit
  2. '模組頂端的 Dim 為這模組中程式可用的變數
  3. Dim WbSh(1 To 3) As Worksheet  '宣告變數型態 指定為工作表
  4. Sub Main()
  5.     Set WbSh(1) = ThisWorkbook.Sheets("數據")
  6.     'ThisWorkbook.Sheets("出餐單")如改為 "出餐單A"
  7.     Set WbSh(2) = ThisWorkbook.Sheets("出餐單") '在此改為 "出餐單A"了就可以了
  8.     Set WbSh(3) = ThisWorkbook.Sheets("快速輸入")
  9.     Call Ex
  10. End Sub
  11. Sub Ex()
  12.     WbSh(1).Range("B22").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  13.     With WbSh(3) '不必 Select來 Select去
  14.         .Range("B2") = "=" & WbSh(2).Range("H1").Address(, , , 1)
  15.             '用公式連結
  16.         .Range("C3") = "=" & WbSh(2).Range("C4").Address(, , , 1)
  17.         .Range("D3") = "=" & WbSh(2).Range("V1").Address(, , , 1)
  18.         .Range("B4") = "=" & WbSh(2).Range("X3").Address(, , , 1)
  19.         .Range("B5") = "=" & WbSh(2).Range("E1").Address(, , , 1)
  20.     End With
  21. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 地上種了菜，就不易長草；心中有善，就不易生惡。
1234567
返回列表 上一主題