關於自動貼上連結至另一個檔案並自動插入超連結 - Excel程式區

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

41^# 跳轉到 »

發表於 2015-5-7 12:31 | 只看該作者

回復 40# starry1314
好像找到哪邊有問題了,如果個別客戶明細的資料是用連結到另一個SHEET的話,他就是複製公式過去所以變得怪怪的

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

42^#

發表於 2015-5-7 13:40 | 只看該作者

回復 41# starry1314
再上傳檔案看看

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

43^#

發表於 2015-5-7 14:20 | 只看該作者

本帖最後由 starry1314 於 2015-5-7 14:22 編輯

回復 42# stillfish00

再麻煩了

範例-自動插入超連結.rar (260.59 KB)

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

44^#

發表於 2015-5-7 19:57 | 只看該作者

回復 43# starry1314
修改如下

Sub 貼上資料至_業務管理TEST自動往下貼一行()
'
' 貼上資料至_業務管理巨集
'
Dim lSourceRow As Long, lTargetRow As Long
Dim wsTarget As Worksheet
With ActiveSheet
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row '被點擊的該按鈕行數
If .Cells(lSourceRow, "B").Text = vbNullString Then MsgBox "日期欄無資料，無法判斷貼上月份": Exit Sub
Set wsTarget = Workbooks("客戶明細-業務專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "B"))) '日期判斷要貼上的工作表
lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1 '要貼上的位置
Application.ScreenUpdating = False
.Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy
wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues
wsTarget.Paste Link:=True
Application.ScreenUpdating = True
End With
'R欄設定超連結到本檔案
With wsTarget
.Hyperlinks.Add Anchor:=.Cells(lTargetRow, "R"), _
Address:=ThisWorkbook.FullName, _
SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
TextToDisplay:=ThisWorkbook.FullName
.Cells(lTargetRow, "R").HorizontalAlignment = xlLeft
End With
End Sub

複製代碼

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

45^#

發表於 2015-5-8 17:58 | 只看該作者

回復 44# stillfish00

感謝幫忙~原來是這樣添加...想到頭都痛了！

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

46^#

發表於 2015-5-10 15:21 | 只看該作者

回復 9# lpk187

不好意思~想請問一下
ActiveSheet.Name 讀取目前工作表名稱
要怎麼套用進下列指令呢?因只要改檔名的話,他就找不到回來的視窗....
Windows("出餐單(請先另存新檔).xlsm").Activate

Sub 小餐單_S餐_自動輸入資料()
'
' 小餐單_自動輸入資料巨集
'
'
Sheets("數據").Select
Range("B25").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("快速輸入").Select
Windows("出餐單(請先另存新檔).xlsm").Activate
Sheets("出餐單").Select
Range("H1:I1").Select
Selection.Copy
Windows("小餐單-S.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste Link:=True
Windows("出餐單(請先另存新檔).xlsm").Activate
Range("C4:AI4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("小餐單-S.xlsm").Activate
Range("C3").Select
ActiveSheet.Paste Link:=True
Windows("出餐單(請先另存新檔).xlsm").Activate
Range("V1:X1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("小餐單-S.xlsm").Activate
Range("D3").Select
ActiveSheet.Paste Link:=True
Windows("出餐單(請先另存新檔).xlsm").Activate
Range("X3:AI3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("小餐單-S.xlsm").Activate
Range("B4").Select
ActiveSheet.Paste Link:=True
Windows("出餐單(請先另存新檔).xlsm").Activate
Range("E1:F1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("小餐單-S.xlsm").Activate
Range("B5").Select
ActiveSheet.Paste Link:=True
Windows("出餐單(請先另存新檔).xlsm").Activate
End Sub

複製代碼

TOP

lpk187

高中生 Rank: 3 Rank: 3

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

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

47^#

發表於 2015-5-10 17:21 | 只看該作者

本帖最後由 lpk187 於 2015-5-10 17:24 編輯

回復 46# starry1314

上面stillfish00大大的程式中就有明示的寫入讀取"本檔的路徑加檔案名稱==>"ThisWorkbook.FullName
以及目前"做用中的工作表名稱"==>ThisWorkbook.ActiveSheet.Name
他的程式你若有用F8一步一步執行，再用區域變數視窗去觀察，不懂的在說明F1中都有很明確的說明，你會學到很多東西，像ThisWorkbook.FullName這句，我也是從stillfish00大大程式中學的
以你PO的這個程式碼是利用錄製的動作寫成的，其實只要你了解了從哪裡來"ThisWorkbook.FullName"然後去哪裡，很多不用寫的像錄製的程式碼那麼的煩雜的

1.以下面這句來說
Windows("出餐單(請先另存新檔).xlsm").Activate
Sheets("出餐單").Select
Range("H1:I1").Select
Selection.Copy
可以把Select、Activate和Selection拿走寫成  Workbooks("出餐單(請先另存新檔).xlsm").Sheets("出餐單").Range("H1:I1").Copy  <<<==這是來源地方

2.下面這句則是目的地方
Windows("小餐單-S.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste Link:=True，因為這裡你是用ActiveSheet所以我並不知道工作表名是什麼所以假設是 Sheets("小餐單")

可以寫成  Workbooks("小餐單-S.xlsm").Sheets("小餐單").Range("B2")
把來源和目的寫在一起是
Workbooks("出餐單(請先另存新檔).xlsm").Sheets("出餐單").Range("H1:I1").Copy Workbooks("小餐單-S.xlsm").Sheets("小餐單").Range("B2")
若是用變數呢？
只能知道目前程式碼的所在檔案也就是ThisWorkbook和目前作用中的工作表ActiveSheet變數如下：

路徑檔名=ThisWorkbook.FullName <<<這個是讀取路徑和檔名的
檔名=ThisWorkbook.Name  <<<<這個只有讀取檔名，這和上面的用途不同
工作表名=ThisWorkbook.ActiveSheet.Name

我在用變數來處理這段 Workbooks("出餐單(請先另存新檔).xlsm").Sheets("出餐單").Range("H1:I1").Copy Workbooks("小餐單-S.xlsm").Sheets("小餐單").Range("B2")
就可以寫成 Workbooks(檔名).Sheets(工作表名).Range("H1:I1").Copy Workbooks("小餐單-S.xlsm").Sheets("小餐單").Range("B2")
甚至我只要把Workbooks("出餐單(請先另存新檔).xlsm").Sheets("出餐單").Range("H1:I1")的值付給 Workbooks("小餐單-S.xlsm").Sheets("小餐單").Range("B2:??")<<這裡的??我假設是C2

可以寫成 Workbooks("小餐單-S.xlsm").Sheets("小餐單").Range("B2:C2")=Workbooks("出餐單(請先另存新檔).xlsm").Sheets("出餐單").Range("H1:I1").Value

上面這2句的不同是來源.copy  目的
      目的 = 來源 (來源有2個以上儲存格必須加上.Value)

這樣寫的話不用Activate來Activate去的，執行的速度也會比較快，前題是2個檔案須同時開著

TOP

lpk187

高中生 Rank: 3 Rank: 3

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

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

48^#

發表於 2015-5-10 17:38 | 只看該作者

回復 46# starry1314

再以stillfish00大大的程式來說明ThisWorkbook.FullName的補充

With wsTarget
      .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "R"), _
                     Address:=ThisWorkbook.FullName, _
                     SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
                     TextToDisplay:=ThisWorkbook.FullName
      .Cells(lTargetRow, "R").HorizontalAlignment = xlLeft
End With
上面程式中的 Address:=ThisWorkbook.FullName 的用途和上篇的 ThisWorkbook.Name 用途不一樣的地方
Address必須指出明確的路徑，所以必須使用 ThisWorkbook.FullName
若是使用 ThisWorkbook.Name 則必須加前面加上路徑，例如"D:\資料夾\" & ThisWorkbook.Name

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

49^#

發表於 2015-5-11 00:18 | 只看該作者

回復 47# lpk187

目前我改寫成這樣...但要怎麼讓他貼上的是連結呢?
目前做法是最後在加上舊指令讓我需要的連結過來....

看了stillfish00大大發的修改前29F→貼上值
修改後44F→貼上連結.
差異有點大.....看得懂意思，但要自己變換就一頭霧水了[code]Sub 小餐單_S餐_自動輸入資料()
'
' 小餐單_S餐_自動輸入資料巨集
'

'
Sheets("數據").Select
Range("B25").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("快速輸入").Select
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B2") = ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("C3") = ThisWorkbook.Sheets("出餐單").Range("C4:AI4").Value
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("D3") = ThisWorkbook.Sheets("出餐單").Range("V1:X1").Value
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B4") = ThisWorkbook.Sheets("出餐單").Range("X3:AI3").Value
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B5") = ThisWorkbook.Sheets("出餐單").Range("E1:F1").Value

'替換值為連結
ThisWorkbook.Sheets("出餐單").Activate
Range("X3:AI3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("小餐單-s.xlsx").Activate
Range("B4").Select
ActiveSheet.Paste Link:=True

End Sub

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

50^#

發表於 2015-5-11 00:57 | 只看該作者

本帖最後由 starry1314 於 2015-5-11 00:59 編輯

回復 47# lpk187

另想請問區域變數視窗要怎麼看呢?
打開後按F8逐行測試
運算式值型態
不太懂怎麼利用以上三項而來了解指令的意義
是以運算式或型態去說明尋找嗎? 用運算式找不到,以形態那找出來的又不太搭

像wsTarget <這是自定義名稱嗎?

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]