1234567
返回列表 上一主題 發帖

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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
21# 跳轉到 »
發表於 2015-5-6 09:28 | 只看該作者
本帖最後由 lpk187 於 2015-5-6 09:30 編輯

回復 20# starry1314
  1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
  2. '
  3. ' 貼上資料至_業務管理 巨集

  5.     'Range("A3:P3").Copy
  6.     sht = ActiveSheet.Name
  7.     arr = Range("A3:P3")
  8.     本檔案的路徑 = ThisWorkbook.Path & "\"
  9.     本檔案的檔名 = ThisWorkbook.Name
  10.    
  11.     Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm") '這裡的"複製的路徑"是要可以開"客戶明細-業務專用.xlsm"的路徑
  12.     Windows("客戶明細-業務專用.xlsm").Activate
  13.     AA = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Address
  14.     EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
  15.     'Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '原本的程序
  16.     Cells(EndRow, "B").Resize(1, UBound(arr, 2)) = Application.Transpose(Application.Transpose(arr)) '目前使用中的分頁,的最下方空白列貼上值
  17.     'ActiveSheet.Paste Link:=True
  18.     Windows("客戶明細-業務專用.xlsm").Activate
  19.     'ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name, SubAddress:=sht'原本的程序
  20.     Windows("客戶明細-業務專用.xlsm").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的路徑 & ThisWorkbook.Name, SubAddress:=sht變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
  21.     Workbooks("客戶明細-業務專用.xlsm").Close True

  23. End Sub
複製代碼
上面是我有修改的程序，其中有解釋路徑

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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


    不好意思~
Windows("客戶明細-業務專用.xlsm").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的路徑 & ThisWorkbook.Name, SubAddress:=sht變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑

此欄一直跑出偵錯,但在前一個尚未修正過的程式 這樣的寫法是正常使用呢

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
23#
發表於 2015-5-6 10:47 | 只看該作者
回復 22# starry1314


    不好意思，上班中，不能即時回應，也沒好好的檢查程序是否錯誤！抱歉
  1. Sub 貼上資料至_業務管理TEST自動往下貼一行()
  2. '
  3. ' 貼上資料至_業務管理 巨集

  5.     'Range("A3:P3").Copy
  6.     sht = ActiveSheet.Name
  7.     arr = Range("A3:P3")
  8.     本檔案的路徑 = ThisWorkbook.Path & "\"
  9.     本檔案的檔名 = ThisWorkbook.Name
  10.     日期 = Format([B3], "M""月")
  11.     Workbooks.Open (ThisWorkbook.Path & "\" & "客戶明細-業務專用.xlsm") '這裡的"複製的路徑"是要可以開"客戶明細-業務專用.xlsm"的路徑
  12.     Windows("客戶明細-業務專用.xlsm").Activate
  13.    
  14.     EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
  15.     'Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '原本的程序
  16.     Cells(EndRow, "B").Resize(1, UBound(arr, 2)) = Application.Transpose(Application.Transpose(arr)) '目前使用中的分頁,的最下方空白列貼上值
  17.     'ActiveSheet.Paste Link:=True
  18.     Workbooks("客戶明細-業務專用.xlsm").Activate
  19.     'ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name, SubAddress:=sht'原本的程序
  20.    
  21.     Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的檔名, SubAddress:=sht '變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
  22.     Workbooks("客戶明細-業務專用.xlsm").Close True

  24. End Sub
複製代碼

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
24#
發表於 2015-5-6 10:51 | 只看該作者
回復 23# lpk187

SubAddress:=sht & "!Q2" 再修改     

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
25#
發表於 2015-5-6 11:21 | 只看該作者
不會啦~是我才不好意思！一直麻煩你
先慢慢測試再理解囉

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
26#
發表於 2015-5-6 11:24 | 只看該作者
回復 19# starry1314

Q1.1.Sheets("五月")<請問關於妳所說的變數
假如在個別客戶明細(Q3)做一個清單 一~十二月,那有什麼指令可以讓"五月" 去讀取那個位置變成動態呢?  cells(Q3) 這樣嗎?

回答上面這問題：
A1.之前我有做一個類似的檔案，但因為考慮使用時間的問題(不用每年的一開始就修改程式或更改檔案名稱以及很多相關的問題)，所以我改用資料庫的做法，把像你月份的工作表改成只有用一個資料庫的工作表
然後再做一個可以查詢的工作表來查詢相關的目的，當然我在資料庫有放所謂年度月份的欄位，以利查詢用。
所以像Sheets("五月")做變數，則是要牽涉到使用的目的才能下方法，而我做的巨集是用工作表事件來代替你的按鈕，而且把月份的數字改成阿拉伯數字，這樣則可以用你日期欄來抓取月份來做變數例如
日期 = Format([B3], "M""月")

A2.若在Q3做清單這也是一個好方法，其變數直指它就可以如：xxx=Range("Q3") 或xxx=[Q3]<<這裡要用中括號(你檔案中的第一個巨集用小括號就不對了)，又或是xxx=Cells(3,"Q")，"不是cells(Q3)"

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
27#
發表於 2015-5-6 12:20 | 只看該作者
Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add
修改過
Workbooks("客戶明細-業務專用.xlsm").Sheets([Q3]).Hyperlinks.Add
這邊要如何轉成變數呢？　上方都換過但還是無法執行~
還是說日期 = Format([B3], "M""月")
我只要再sheets(日期) 這樣嗎?

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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


    請問 Windows("目前所在檔名.xlsm").Activate
可更改為
Windows("ThisWorkbook.Name").Activate 嗎?

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
29#
發表於 2015-5-6 13:53 | 只看該作者
回復 27# 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.         Set wsTarget = Workbooks("客戶明細-業務專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "B"))) '日期判斷要貼上的工作表
  11.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '要貼上的位置
  12.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy wsTarget.Cells(lTargetRow, "B") '複製貼上該行資料
  13.     End With
  14.    
  15.     'Q欄設定超連結到本檔案
  16.     With wsTarget
  17.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "Q"), _
  18.                         Address:=ThisWorkbook.FullName, _
  19.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
  20.                         TextToDisplay:=.Cells(lTargetRow, "Q").Text
  21.     End With
  22. End Sub

  24. '工作表用中文字要自己寫function轉，如果是1月、2月...可用 Format(日期,"m月")轉換較方便
  25. Function GetMonthStr(inDate As Date) As String
  26.     Select Case Month(inDate)
  27.         Case 1
  28.             GetMonthStr = "一月"
  29.         Case 2
  30.             GetMonthStr = "二月"
  31.         Case 3
  32.             GetMonthStr = "三月"
  33.         Case 4
  34.             GetMonthStr = "四月"
  35.         Case 5
  36.             GetMonthStr = "五月"
  37.         Case 6
  38.             GetMonthStr = "六月"
  39.         Case 7
  40.             GetMonthStr = "七月"
  41.         Case 8
  42.             GetMonthStr = "八月"
  43.         Case 9
  44.             GetMonthStr = "九月"
  45.         Case 10
  46.             GetMonthStr = "十月"
  47.         Case 11
  48.             GetMonthStr = "十一月"
  49.         Case 12
  50.             GetMonthStr = "十二月"
  51.     End Select
  52. End Function
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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

回復 29# stillfish00


  不好意思~使用結果沒有反應易沒有跳出偵錯.....
另想問一下
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被點擊的該按鈕行數
是滑鼠點擊的所在位置的行數嗎?
還是按鈕所在的行數?

TOP

        靜思自在 : 君子如水，隨方就圓，無處不自在。
1234567
返回列表 上一主題