1234567
返回列表 上一主題 發帖

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

lpk187

帖子
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

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 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
  1. Sub 小餐單_S餐_自動輸入資料()
  2. '
  3. ' 小餐單_自動輸入資料 巨集
  4. '

  6. '
  7.     Sheets("數據").Select
  8.     Range("B25").Select
  9.     Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  10.     Sheets("快速輸入").Select
  11.     Windows("出餐單(請先另存新檔).xlsm").Activate
  12.     Sheets("出餐單").Select
  13.     Range("H1:I1").Select
  14.     Selection.Copy
  15.     Windows("小餐單-S.xlsm").Activate
  16.     Range("B2").Select
  17.     ActiveSheet.Paste Link:=True
  18.     Windows("出餐單(請先另存新檔).xlsm").Activate
  19.     Range("C4:AI4").Select
  20.     Application.CutCopyMode = False
  21.     Selection.Copy
  22.     Windows("小餐單-S.xlsm").Activate
  23.     Range("C3").Select
  24.     ActiveSheet.Paste Link:=True
  25.     Windows("出餐單(請先另存新檔).xlsm").Activate
  26.     Range("V1:X1").Select
  27.     Application.CutCopyMode = False
  28.     Selection.Copy
  29.     Windows("小餐單-S.xlsm").Activate
  30.     Range("D3").Select
  31.     ActiveSheet.Paste Link:=True
  32.     Windows("出餐單(請先另存新檔).xlsm").Activate
  33.     Range("X3:AI3").Select
  34.     Application.CutCopyMode = False
  35.     Selection.Copy
  36.     Windows("小餐單-S.xlsm").Activate
  37.     Range("B4").Select
  38.     ActiveSheet.Paste Link:=True
  39.     Windows("出餐單(請先另存新檔).xlsm").Activate
  40.     Range("E1:F1").Select
  41.     Application.CutCopyMode = False
  42.     Selection.Copy
  43.     Windows("小餐單-S.xlsm").Activate
  44.     Range("B5").Select
  45.     ActiveSheet.Paste Link:=True
  46.     Windows("出餐單(請先另存新檔).xlsm").Activate
  47.     End Sub
複製代碼

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 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

帖子
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
修改如下
  1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
  2. '
  3. ' 貼上資料至_業務管理 巨集
  4. '
  5.     Dim lSourceRow As Long, lTargetRow As Long
  6.     Dim wsTarget As Worksheet
  7.    
  8.     With ActiveSheet
  9.         lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被點擊的該按鈕行數
  10.         If .Cells(lSourceRow, "B").Text = vbNullString Then MsgBox "日期欄無資料，無法判斷貼上月份": Exit Sub
  11.         Set wsTarget = Workbooks("客戶明細-業務專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "B"))) '日期判斷要貼上的工作表
  12.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '要貼上的位置
  13.         Application.ScreenUpdating = False
  14.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy
  15.         wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues
  16.         wsTarget.Paste Link:=True
  17.         Application.ScreenUpdating = True
  18.     End With
  19.    
  20.     'R欄設定超連結到本檔案
  21.     With wsTarget
  22.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "R"), _
  23.                         Address:=ThisWorkbook.FullName, _
  24.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
  25.                         TextToDisplay:=ThisWorkbook.FullName
  26.         .Cells(lTargetRow, "R").HorizontalAlignment = xlLeft
  27.     End With
  28. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 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

帖子
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: 3Rank: 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: 3Rank: 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: 3Rank: 3

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


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

上一個巨集可以貼上連結
不知該怎麼更換寫法套入你的巨集,讓他貼上的時候可以貼上連結
  1. Sub 貼上資料至_業務管理()
  2. '
  3. ' 貼上資料至_業務管理 巨集
  4. '
  5.   
  6.     Range("A3:P3").Copy
  7.     Windows("客戶明細-業務專用.xlsm").Activate
  8.     EndRow = Windows("客戶明細-業務專用.xlsm").ActiveSheet.Range(Cells(Rows.Count, "A").End(xlUp).Address).Row + 1  '所有使用中的列數+1
  9.     Windows("客戶明細-業務專用.xlsm").ActiveSheet.Cells(EndRow, "A").PasteSpecial Paste:=xlPasteValues '目前使用中的分頁,的最下方空白列貼上值
  10.     ActiveSheet.Paste Link:=True
  11.     Application.CutCopyMode = False
  12.     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ThisWorkbook.Path & "\" & ThisWorkbook.Name

  14. End Sub
複製代碼

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 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

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
1234567
返回列表 上一主題