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

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

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

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

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

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

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

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

41^#

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

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

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

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

40^#

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

回復 37# stillfish00

關於點擊按鈕後複製的資料並不是在當前的SHEET,一直抓取到另一個sheet
剛剛說把分頁複製到個別客戶明細,有成功抓取對的資料
但之後再開啟他又是抓到別SHEET的資料了...

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

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

39^#

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

回復 37# stillfish00

後來我將多個需要參照的工作表移動到[範例-插入超連結],執行按鈕就可以正確讀取資料了,
但想請問怎麼讓他可以貼上連結而不是貼上值呢?

上一個巨集可以貼上連結
不知該怎麼更換寫法套入你的巨集,讓他貼上的時候可以貼上連結

Sub 貼上資料至_業務管理()
'
' 貼上資料至_業務管理巨集
'
Range("A3:P3").Copy
Windows("客戶明細-業務專用.xlsm").Activate
EndRow = Windows("客戶明細-業務專用.xlsm").ActiveSheet.Range(Cells(Rows.Count, "A").End(xlUp).Address).Row + 1 '所有使用中的列數+1
Windows("客戶明細-業務專用.xlsm").ActiveSheet.Cells(EndRow, "A").PasteSpecial Paste:=xlPasteValues '目前使用中的分頁,的最下方空白列貼上值
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ThisWorkbook.Path & "\" & ThisWorkbook.Name
End Sub

複製代碼

TOP

starry1314

　暱稱: 豪

高中生 Rank: 3 Rank: 3

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

38^#

發表於 2015-5-7 10:11 | 只看該作者

本帖最後由 starry1314 於 2015-5-7 10:25 編輯

回復 37# stillfish00

將你提供的巨集指令填寫到另一個含多個工作頁的個別客戶明細內,(裡面同樣有一個收款跟催一模一樣的)
另此收款跟催的資料是用連結取到出餐單內的資料,好像貼到業務明細內如果在第2個他連結會一直變動, ,所以才加上連結,
另可以貼上連結與超連結嗎? 要讓業務明細內的資料同步跟著個別客戶明細更新

TOP

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

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

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