標題:
[發問]
關於自動貼上連結至另一個檔案並自動插入超連結
[打印本頁]
作者:
starry1314
時間:
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並且可插入超連結
[attach]20868[/attach]
Sub 貼上資料至_業務管理()
'
' 貼上資料至_業務管理 巨集
'
Range("A3:P3").Select
Selection.Copy
Windows("客戶明細-業務專用.xlsm").Activate
Range("B7").Select
ActiveSheet.Paste Link:=True
Windows("客戶明細-業務專用.xlsm").Activate
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"..\..\業務\業務明細.xlsm"
End Sub
複製代碼
[attach]20871[/attach]
[attach]20872[/attach]
作者:
starry1314
時間:
2015-5-5 21:45
請問有人可以交一下adrdrees那邊的指令該如何設定嗎
作者:
lpk187
時間:
2015-5-5 22:01
回復
2#
starry1314
看不懂你的連結是要連到哪裡,
像這樣嗎?
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="客戶明細-業務專用.xlsm", SubAddress:="五月!A1"
作者:
starry1314
時間:
2015-5-5 22:07
回復 starry1314
看不懂你的連結是要連到哪裡,
像這樣嗎?
ActiveSheet.Hyperlinks.Add Anch ...
lpk187 發表於 2015-5-5 22:01
在個別客戶明細內有個轉置按鈕-是要將客戶的個資自動貼上連結到業務明細那邊,好讓業務之後可以從[業務明細]的檔案內直接點擊連結到[個別的客戶明細]
是要將[個別客戶明細]的資料做超連結至[業務明細],個別客戶明細的檔名不是固定的每個檔案都屬於個人,至於[業務明細]則是固定的
作者:
lpk187
時間:
2015-5-5 22:09
回復
2#
starry1314
還是這樣?
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="個別客戶明細(請先另存新檔).xlsm", SubAddress:="收款跟催!Q2"
還有你的連結要放哪裡?你的問題中也沒說清楚!所以我只能猜測
作者:
starry1314
時間:
2015-5-5 22:19
回復
5#
lpk187
我原本設定在個別客戶明細的按鈕(是將本頁A2:P2)的資料貼到(業務明細)的檔案去
但目前不知道怎麼用才可讓他自動插入超連結(隨目前[客戶明細.xlsm]檔案而自動變更
只知道在adrwwa=_後方加入指定的路經可以自動插入超連結成功,但不會寫隨檔案位至變動而自動變動
想說在Q2設cell(filename) 可讓他讀取路徑,在自動貼上~但都無效果
作者:
starry1314
時間:
2015-5-5 22:27
回復
5#
lpk187
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"
..\..\業務\個別客戶明細.xlsm
" <<這串為指定位置,想改成讓他自動讀取我目前檔案所在的路徑,並插入超連結至[業務明細]
作者:
starry1314
時間:
2015-5-5 22:33
回復
6#
starry1314
讓A檔案的資料自動貼到B檔案,並在B檔案複製過去的資料欄位上,插入目前A檔案所在位置的超連結路徑
作者:
lpk187
時間:
2015-5-5 22:41
本帖最後由 lpk187 於 2015-5-5 22:46 編輯
回復
6#
starry1314
Windows("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add Anchor:=Windows("客戶明細-業務專用.xlsm").Sheets("五月").Range("B7"), Address:=ThisWorkbook.Name, SubAddress:=ActiveSheet.Name & "!Q2"
其中 ThisWorkbook.Name 是"取得"個別客戶的工作簿名稱
ActiveSheet.Name是目前的工作表名稱
會用這2個是你說個別客戶的工作簿名稱會不同所以可以用這樣來讀取其名稱
作者:
lpk187
時間:
2015-5-5 22:50
回復
7#
starry1314
若要再讀取路徑可用ThisWorkbook.Path & "\" & ThisWorkbook.Name
所以可以這樣 Address:=ThisWorkbook.Path & "\" & ThisWorkbook.Name, SubAddress:=ActiveSheet.Name & "!Q2"
作者:
starry1314
時間:
2015-5-5 23:18
回復
10#
lpk187
感謝幫忙~使用上方指令讀取 Q2用cell(filename)叫出來的路徑不知為何會參照錯誤
所以我只使用到 Address:=ThisWorkbook.Name 這樣也能達成我想要的效果(如下方代碼)
另想再知道如何在
以下這代碼中 插入這串自動在最下方空白列貼上的指令呢
EndRow = ActiveSheet.UsedRange.Rows.Count + 1 '所有使用中的列數+1
Rows(EndRow).PasteSpecial Paste:=xlPasteValues'目前使用中的分頁,的最下方空白列貼上值
因如果把Range("B7").Select拿掉,變成是以我滑鼠點選的儲值格為開頭去貼上
如果要他讓他以A1.A2.A3.A4這樣自動依序往下貼上不知該如何更改呢
Sub 貼上資料至_業務管理TEST自動往下貼一行()
'
' 貼上資料至_業務管理 巨集
'
'
Range("A3:P3").Select
Selection.Copy
Windows("客戶明細-業務專用.xlsm").Activate
Range("B7").Select
ActiveSheet.Paste Link:=True
Windows("客戶明細-業務專用.xlsm").Activate
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ThisWorkbook.Name
End Sub
複製代碼
作者:
starry1314
時間:
2015-5-6 08:15
本帖最後由 starry1314 於 2015-5-6 08:25 編輯
回復
11#
starry1314
不知&!Q2是要怎麼修正呢,
狀況:
1.參照路徑會錯誤,
2.也會在業務明細新貼上業務明細的檔案路徑
作者:
lpk187
時間:
2015-5-6 08:24
回復
12#
starry1314
Sub 貼上資料至_業務管理TEST自動往下貼一行()
'
' 貼上資料至_業務管理 巨集
'
'
Range("A3:P3").Copy
Workbooks.Open (ThisWorkbook.Path & "\" & "客戶明細-業務專用.xlsm")
Windows("客戶明細-業務專用.xlsm").Activate
EndRow = Windows("客戶明細-業務專用.xlsm").Sheets("五月").Range("B4", Cells(Rows.Count, "B").End(xlUp).Address).Row + 1 '所有使用中的列數+1
Windows("客戶明細-業務專用.xlsm").Sheets("五月").Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '目前使用中的分頁,的最下方空白列貼上值
ActiveSheet.Paste Link:=True
Windows("客戶明細-業務專用.xlsm").Activate
ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name
Workbooks("客戶明細-業務專用.xlsm").Close True
End Sub
複製代碼
作者:
lpk187
時間:
2015-5-6 08:30
回復
12#
starry1314
路徑的問題,若要用網路磁碟機那路徑就要設絕對路徑給它
如下圖把路徑複製起來然後 Address:="複製的路徑" & "\" & ThisWorkbook.Name
作者:
starry1314
時間:
2015-5-6 08:39
本帖最後由 starry1314 於 2015-5-6 08:40 編輯
回復
14#
lpk187
了解~那
EndRow = Windows("客戶明細-業務專用.xlsm").ActiveSheet.Range("b4", Cells(Rows.Count, "A").End(xlUp).Address).Row + 1 '所有使用中的列數+1
假如B4,B5已有資料~他會變成在業務專用的B5的位置覆蓋 不會跑到B6去呢
應該是Range("b4", 讓他一直重B4+1吧?
所以我將它拿掉改成
EndRow = Windows("客戶明細-業務專用.xlsm").ActiveSheet.Range( Cells(Rows.Count, "A").End(xlUp).Address).Row + 1 '所有使用中的列數+1
即可以自動往下了
但不知為何如果點擊超連結之後跳回 個別客戶明細都會參照錯誤...
作者:
lpk187
時間:
2015-5-6 08:43
本帖最後由 lpk187 於 2015-5-6 08:44 編輯
回復
12#
starry1314
程序修改如下
Sub 貼上資料至_業務管理TEST自動往下貼一行()
'
' 貼上資料至_業務管理 巨集
'
'
Range("A3:P3").Copy
Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm")
Windows("客戶明細-業務專用.xlsm").Activate
EndRow = Windows("客戶明細-業務專用.xlsm").Sheets("五月").Range("B4", Cells(Rows.Count, "B").End(xlUp).Address).Row + 1 '所有使用中的列數+1
Windows("客戶明細-業務專用.xlsm").Sheets("五月").Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '目前使用中的分頁,的最下方空白列貼上值
ActiveSheet.Paste Link:=True
Windows("客戶明細-業務專用.xlsm").Activate
ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:="複製的路徑" & "\" & ThisWorkbook.Name
Workbooks("客戶明細-業務專用.xlsm").Close True
End Sub
複製代碼
其中的Sheets("五月"),你可以用變數來讓它變成動態的,或是讓使用者自己選擇,也或是依照日期來選擇,方法有很多,
還有ActiveSheet也可以用Sheets("五月")的變數取代之
連 Range("A3:P3").Copy這個也可以讓它成為變數
在程式中除非必要,否則盡量不要用.Select或.Activate,因為這樣產生的bug也會很多的,而且動作也會變慢!
作者:
lpk187
時間:
2015-5-6 08:48
回復
15#
starry1314
ActiveSheet.Range("b4", Cells(Rows.Count, "A").End(xlUp).Address).Row + 1
這句的意思是從居b4開始到B欄的最後儲存格然後再加1為下一個儲存格
作者:
lpk187
時間:
2015-5-6 08:56
回復
16#
lpk187
語法錯誤應該是這樣才對
EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
作者:
starry1314
時間:
2015-5-6 08:58
1.Sheets("五月")<請問關於妳所說的變數
假如在個別客戶明細(Q3)做一個清單 一~十二月,那有什麼指令可以讓"五月" 去讀取那個位置變成動態呢? cells(Q3) 這樣嗎?
Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm")
因客戶明細-業務專用.xlsm會有好幾個業務的,如 \\..\..\..\..\業務專用 內有不同業務的資料夾,再下一層才會是客戶明細-業務專用.xlsm
所以可以用
Workbooks.Open (" \\..\..\..\..\業務專用" &"不同業務的資料夾(依O3內容的名稱變更)"& "\" & "客戶明細-業務專用.xlsm")
如業務專用(複製路徑)," &"業務-張, "& "\" & "客戶明細-業務專用.xlsm" 像這樣可以達成嗎
作者:
starry1314
時間:
2015-5-6 09:08
回復
18#
lpk187
點擊超連結後 參照路徑錯誤的問題知道哪邊出問題了
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ThisWorkbook.Path & "\" & ThisWorkbook.Name, SubAddress:=ActiveSheet.Name
SubAddress:=ActiveSheet.Name '導致業務明細的超連結會讀取業務明細的目前工作頁名稱, 變成 個別客戶明細(超連結)-
五月
'
作者:
lpk187
時間:
2015-5-6 09:28
本帖最後由 lpk187 於 2015-5-6 09:30 編輯
回復
20#
starry1314
Sub 貼上資料至_業務管理TEST自動往下貼一行()
'
' 貼上資料至_業務管理 巨集
'Range("A3:P3").Copy
sht = ActiveSheet.Name
arr = Range("A3:P3")
本檔案的路徑 = ThisWorkbook.Path & "\"
本檔案的檔名 = ThisWorkbook.Name
Workbooks.Open ("複製的路徑" & "\" & "客戶明細-業務專用.xlsm") '這裡的"複製的路徑"是要可以開"客戶明細-業務專用.xlsm"的路徑
Windows("客戶明細-業務專用.xlsm").Activate
AA = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Address
EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
'Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '原本的程序
Cells(EndRow, "B").Resize(1, UBound(arr, 2)) = Application.Transpose(Application.Transpose(arr)) '目前使用中的分頁,的最下方空白列貼上值
'ActiveSheet.Paste Link:=True
Windows("客戶明細-業務專用.xlsm").Activate
'ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name, SubAddress:=sht'原本的程序
Windows("客戶明細-業務專用.xlsm").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的路徑 & ThisWorkbook.Name, SubAddress:=sht變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
Workbooks("客戶明細-業務專用.xlsm").Close True
End Sub
複製代碼
上面是我有修改的程序,其中有解釋路徑
作者:
starry1314
時間:
2015-5-6 10:02
回復
21#
lpk187
不好意思~
Windows("客戶明細-業務專用.xlsm").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的路徑 & ThisWorkbook.Name, SubAddress:=sht變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
此欄一直跑出偵錯,但在前一個尚未修正過的程式 這樣的寫法是正常使用呢
作者:
lpk187
時間:
2015-5-6 10:47
回復
22#
starry1314
不好意思,上班中,不能即時回應,也沒好好的檢查程序是否錯誤!抱歉
Sub 貼上資料至_業務管理TEST自動往下貼一行()
'
' 貼上資料至_業務管理 巨集
'Range("A3:P3").Copy
sht = ActiveSheet.Name
arr = Range("A3:P3")
本檔案的路徑 = ThisWorkbook.Path & "\"
本檔案的檔名 = ThisWorkbook.Name
日期 = Format([B3], "M""月")
Workbooks.Open (ThisWorkbook.Path & "\" & "客戶明細-業務專用.xlsm") '這裡的"複製的路徑"是要可以開"客戶明細-業務專用.xlsm"的路徑
Windows("客戶明細-業務專用.xlsm").Activate
EndRow = Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Cells(Rows.Count, "B").End(xlUp).Row + 1 '所有使用中的列數+1
'Cells(EndRow, "B").PasteSpecial Paste:=xlPasteValues '原本的程序
Cells(EndRow, "B").Resize(1, UBound(arr, 2)) = Application.Transpose(Application.Transpose(arr)) '目前使用中的分頁,的最下方空白列貼上值
'ActiveSheet.Paste Link:=True
Workbooks("客戶明細-業務專用.xlsm").Activate
'ActiveSheet.Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=ThisWorkbook.Name, SubAddress:=sht'原本的程序
Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add Anchor:=Cells(EndRow, "B"), Address:=本檔案的檔名, SubAddress:=sht '變更後的 '這裡的本檔案的路徑則是這個檔案所在的路徑
Workbooks("客戶明細-業務專用.xlsm").Close True
End Sub
複製代碼
作者:
lpk187
時間:
2015-5-6 10:51
回復
23#
lpk187
SubAddress:=sht & "!Q2" 再修改
作者:
starry1314
時間:
2015-5-6 11:21
不會啦~是我才不好意思!一直麻煩你
先慢慢測試再理解囉
作者:
lpk187
時間:
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)"
作者:
starry1314
時間:
2015-5-6 12:20
Workbooks("客戶明細-業務專用.xlsm").Sheets("五月").Hyperlinks.Add
修改過
Workbooks("客戶明細-業務專用.xlsm").
Sheets([Q3])
.Hyperlinks.Add
這邊要如何轉成變數呢? 上方都換過但還是無法執行~
還是說日期 = Format([B3], "M""月")
我只要再sheets(日期) 這樣嗎?
作者:
starry1314
時間:
2015-5-6 13:32
回復
10#
lpk187
請問 Windows("目前所在檔名.xlsm").Activate
可更改為
Windows("ThisWorkbook.Name").Activate 嗎?
作者:
stillfish00
時間:
2015-5-6 13:53
回復
27#
starry1314
可試試看
Sub 貼上資料至_業務管理TEST自動往下貼一行()
'
' 貼上資料至_業務管理 巨集
'
Dim lSourceRow As Long, lTargetRow As Long
Dim wsTarget As Worksheet
With ActiveSheet
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row '被點擊的該按鈕行數
Set wsTarget = Workbooks("客戶明細-業務專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "B"))) '日期判斷要貼上的工作表
lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1 '要貼上的位置
.Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy wsTarget.Cells(lTargetRow, "B") '複製貼上該行資料
End With
'Q欄設定超連結到本檔案
With wsTarget
.Hyperlinks.Add Anchor:=.Cells(lTargetRow, "Q"), _
Address:=ThisWorkbook.FullName, _
SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
TextToDisplay:=.Cells(lTargetRow, "Q").Text
End With
End Sub
'工作表用中文字要自己寫function轉,如果是1月、2月...可用 Format(日期,"m月")轉換較方便
Function GetMonthStr(inDate As Date) As String
Select Case Month(inDate)
Case 1
GetMonthStr = "一月"
Case 2
GetMonthStr = "二月"
Case 3
GetMonthStr = "三月"
Case 4
GetMonthStr = "四月"
Case 5
GetMonthStr = "五月"
Case 6
GetMonthStr = "六月"
Case 7
GetMonthStr = "七月"
Case 8
GetMonthStr = "八月"
Case 9
GetMonthStr = "九月"
Case 10
GetMonthStr = "十月"
Case 11
GetMonthStr = "十一月"
Case 12
GetMonthStr = "十二月"
End Select
End Function
複製代碼
作者:
starry1314
時間:
2015-5-6 14:29
本帖最後由 starry1314 於 2015-5-6 14:39 編輯
回復
29#
stillfish00
不好意思~使用結果沒有反應易沒有跳出偵錯.....
另想問一下
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row '被點擊的該按鈕行數
是滑鼠點擊的所在位置的行數嗎?
還是按鈕所在的行數?
作者:
stillfish00
時間:
2015-5-6 16:12
本帖最後由 stillfish00 於 2015-5-6 16:14 編輯
回復
30#
starry1314
呼叫該巨集的按鈕,該按鈕左上角座標所在儲存格的行數
是根據客戶資料日期判斷,所以4/23跑完會貼到四月工作表
作者:
starry1314
時間:
2015-5-6 16:57
本帖最後由 starry1314 於 2015-5-6 16:59 編輯
回復
31#
stillfish00
了解~感謝說明
請問你用的這組代碼可以試跑成功嗎?我用一直沒有反應,也沒說出錯~不知該從哪找問題
作者:
stillfish00
時間:
2015-5-6 17:08
回復
32#
starry1314
可以,開啟兩檔案啟用巨集,按個別客戶的轉置-業務按鈕
四月工作表就有資料了
附件:
[attach]20879[/attach]
作者:
starry1314
時間:
2015-5-6 21:59
本帖最後由 starry1314 於 2015-5-6 22:07 編輯
回復
33#
stillfish00
恩...原來是寫的太神了!!毫無反應就已經貼完了。。。。
感謝∼
想請問一下你們是怎麼判斷如 Windows("客戶明細-業務專用.xlsm").Activate
要再windows後方加上各種動態或指令,你們是怎麼判斷哪種指令該怎麼表示 如 = ,() ,"" .[] 或是要讓他讀取動態 如
LPK大大
再26F所回覆的
A2.若在Q3做清單這也是一個好方法,其變數直指它就可以如:xxx=Range("Q3") 或xxx=[Q3]<<這裡要用中括號(你檔案中的第一個巨集用小括號就不對了),又或是xxx=Cells(3,"Q"),"不是cells(Q3)"
或是有什麼建議的書籍有再講解關於這種的說明呢...書局的書都是範例照表操課 一直跟著做而已.....沒有較詳細講解這種的,對很多指令都一知半解!在這個檔案會用∼再另一個方法的檔案就不會做變通了。。。
作者:
starry1314
時間:
2015-5-7 09:23
回復
29#
stillfish00
請問要怎麼指定sheet呢?因我套用在別的檔案,發現他都是讀取第一個工作表的資料
我想要複製的資料工作表名稱= 收款跟催
作者:
starry1314
時間:
2015-5-7 09:42
本帖最後由 starry1314 於 2015-5-7 09:53 編輯
回復
35#
starry1314
1.
Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy wsTarget.Cells(lTargetRow, "B") '複製貼上該行資料
修改為
Range(.Cells(lSourceRow, "收款跟催!A"), .Cells(lSourceRow, "P")).Copy wsTarget.Cells(lTargetRow, "收款跟催!B") '複製貼上該行資料
無法執行..
2.
Worksheets("收款跟催").Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy wsTarget.Cells(lTargetRow, "B") '複製貼上該行資料
還是第一個工作表的資料
作者:
stillfish00
時間:
2015-5-7 09:56
回復
35#
starry1314
你怎麼套用的???
程式複製來源的是當前的工作表ActiveSheet
因為你的'收款跟催'工作表中該資料行有按鈕
按鈕觸發時的ActiveSheet就是收款跟催工作表
作者:
starry1314
時間:
2015-5-7 10:11
本帖最後由 starry1314 於 2015-5-7 10:25 編輯
回復
37#
stillfish00
將你提供的巨集指令填寫到另一個含多個工作頁的個別客戶明細內,(裡面同樣有一個收款跟催一模一樣的)
另此收款跟催的資料是用連結取到出餐單內的資料,好像貼到業務明細內如果在第2個他連結會一直變動, ,所以才加上連結,
另可以貼上連結與超連結嗎? 要讓業務明細內的資料同步跟著個別客戶明細更新
[attach]20885[/attach]
作者:
starry1314
時間:
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
複製代碼
作者:
starry1314
時間:
2015-5-7 12:00
回復
37#
stillfish00
關於點擊按鈕後複製的資料並不是在當前的SHEET,一直抓取到另一個sheet
剛剛說把分頁複製到個別客戶明細,有成功抓取對的資料
但之後再開啟他又是抓到別SHEET的資料了...
作者:
starry1314
時間:
2015-5-7 12:31
回復
40#
starry1314
好像找到哪邊有問題了,如果個別客戶明細的資料是用連結到另一個SHEET的話,他就是複製公式過去所以變得怪怪的
作者:
stillfish00
時間:
2015-5-7 13:40
回復
41#
starry1314
再上傳檔案看看
作者:
starry1314
時間:
2015-5-7 14:20
本帖最後由 starry1314 於 2015-5-7 14:22 編輯
回復
42#
stillfish00
再麻煩了
[attach]20887[/attach]
作者:
stillfish00
時間:
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
複製代碼
作者:
starry1314
時間:
2015-5-8 17:58
回復
44#
stillfish00
感謝幫忙~原來是這樣添加...想到頭都痛了!
作者:
starry1314
時間:
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
複製代碼
作者:
lpk187
時間:
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個檔案須同時開著
作者:
lpk187
時間:
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
作者:
starry1314
時間:
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
作者:
starry1314
時間:
2015-5-11 00:57
本帖最後由 starry1314 於 2015-5-11 00:59 編輯
回復
47#
lpk187
另想請問區域變數視窗要怎麼看呢?
打開後按F8逐行測試
運算式 值 型態
不太懂怎麼利用以上三項而來了解指令的意義
是以運算式或型態去說明尋找嗎? 用運算式找不到,以形態那找出來的又不太搭
像wsTarget <這是自定義名稱嗎?
作者:
GBKEE
時間:
2015-5-11 05:51
回復
50#
starry1314
[attach]20919[/attach]
作者:
lpk187
時間:
2015-5-11 09:31
回復
49#
starry1314
我先回複這問題
Sheets("快速輸入").Select" '因為這裡已選取Sheets("快速輸入")這個工作表所以下面不能這樣寫,ThisWorkbook.Sheets("出餐單")是程式碼所在的地方,除非你的程式碼是放在.ThisWorkbook.Sheets("出餐單")這個工作表否則不能這樣寫
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B2") = ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value
我假設你的程式碼放在ThisWorkbook.Sheets("出餐單")這裡,而你先又做了Sheets("快速輸入").Select,你的程式可以簡寫成
Range("B2") = ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value
若是沒做Sheets("快速輸入").Select選取的話,也就是畫面是停留在ThisWorkbook.Sheets("出餐單")這個工作表中則可以簡寫成
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B2") =.Range("H1:I1").Value
作者:
lpk187
時間:
2015-5-11 09:41
回復
50#
starry1314
版主出來回複了。不過我再補充一下你因為不知道你所輸入的值是否對錯可以用變數來觀看
也是說,以Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B2") = ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value來說
可以用
AA=ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value'來看你的程式碼是右有輸入錯誤再列下面這行
你可以在區域變數視窗中明白的看出AA這個變數的變化了
Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B2") = ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value
然後再用一個變數來觀看Workbooks("小餐單-S.xlsx").Sheets("快速輸入").Range("B2")輸入對不對依此法類推,就可以很清楚的了解怎麼來怎麼去了
還有 ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value的"H1:I1"是合併儲存格的話可以只用"H1就可以了例如"ThisWorkbook.Sheets("出餐單").Range("H1").Value
作者:
starry1314
時間:
2015-5-11 10:02
回復
53#
lpk187
了解~所以要用區域變數視窗來觀看就是要先給指令一個變數才有辦法一個一個觀看執行結果囉|?
如
AA=
ThisWorkbook.Sheets("出餐單").Range("H1:I1").Value'
先來了解看看~
作者:
starry1314
時間:
2015-5-11 10:03
回復
51#
GBKEE
感謝版主~這個視窗我有執行出來!但在形態下方那個紅框,不懂要怎麼了解涵義! 我先找其他的程式碼來看看差異性在哪好了
作者:
GBKEE
時間:
2015-5-11 10:46
回復
55#
starry1314
Option Explicit
Sub EX()
Dim AR(1 To 2) As Integer
'Integer 變數係以範圍為 -32,768 到 32,767 之 16 位元 (2 個位元組) 數字的形式儲存
AR(1) = 5
AR(2) = 15
AR(2) = "w15" '<- 資料型態不對 已指定資料型態所以錯誤產生了
End Sub
複製代碼
作者:
starry1314
時間:
2015-5-11 14:36
回復
52#
lpk187
了解!因程式碼是放在.ThisWorkbook.Sheets("出餐單")所以讀取的資料是正確的,
目前想請問 =或是copy 都是複製值 可以改成什麼讓他貼上的是連結呢?
ActiveSheet.Paste Link:=True
<--原本貼上連結的方式
目前修正為
Sheets("數據").Select
Range("B22").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("快速輸入").Select
Range("B2") = ThisWorkbook.Sheets("出餐單").Range("H1").Value
Range("C3") = ThisWorkbook.Sheets("出餐單").Range("C4").Value
Range("D3") = ThisWorkbook.Sheets("出餐單").Range("V1").Value
Range("B4") = ThisWorkbook.Sheets("出餐單").Range("X3").Value
Range("B5") = ThisWorkbook.Sheets("出餐單").Range("E1").Value
End Sub
複製代碼
作者:
GBKEE
時間:
2015-5-11 16:01
回復
57#
starry1314
Option Explicit
'模組頂端的 Dim 為這模組中程式可用的變數
Dim WbSh(1 To 3) As Worksheet '宣告變數型態 指定為工作表
Sub Main()
Set WbSh(1) = ThisWorkbook.Sheets("數據")
'ThisWorkbook.Sheets("出餐單")如改為 "出餐單A"
Set WbSh(2) = ThisWorkbook.Sheets("出餐單") '在此改為 "出餐單A"了就可以了
Set WbSh(3) = ThisWorkbook.Sheets("快速輸入")
Call Ex
End Sub
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
複製代碼
作者:
lpk187
時間:
2015-5-11 19:28
呵呵呵!版主大大太強了,說真的當初我沒看到
ActiveSheet.Paste Link:=True這行
還再想怎麼回starry1314這個程式碼,版主大大就出手相助,這程式碼也讓我受易良多
作者:
starry1314
時間:
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
作者:
starry1314
時間:
2015-5-12 14:29
回復
58#
GBKEE
目前改為以下指令,已解決連結問題,
Sub 小餐單_A餐_自動輸入資料()
Sheets("數據").Select
Range("B22").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("快速輸入").Select
Range("B2") = "=" & ThisWorkbook.Sheets("出餐單").Range("H1").Address(, , , 1)
Range("C3") = "=" & ThisWorkbook.Sheets("出餐單").Range("C4").Address(, , , 1)
Range("D3") = "=" & ThisWorkbook.Sheets("出餐單").Range("V1").Address(, , , 1)
Range("B4") = "=" & ThisWorkbook.Sheets("出餐單").Range("X3").Address(, , , 1)
Range("B5") = "=" & ThisWorkbook.Sheets("出餐單").Range("E1").Address(, , , 1)
End Sub
複製代碼
作者:
GBKEE
時間:
2015-5-12 15:37
本帖最後由 GBKEE 於 2015-5-12 15:41 編輯
回復
60#
starry1314
[attach]20931[/attach]
Sub Ex()
End
'當執行到 End 陳述式時,陳述式會重新設定在所有模組中的所有模組層次變數以及所有靜態區域變數。
'若要保留這些變數的值,請使用 Stop 陳述式來取代 End ,然後您可以在稍後繼續執行。
End Sub
複製代碼
模組共用的私用變數執行後會存在於 VBA中
若有執行 End 陳述式
或如圖的 重新設定
變數需再度設定
也就是說
給你的 Sub Main()須執行一次,
給你的 Sub Ex() 才沒有錯誤的
作者:
starry1314
時間:
2015-5-12 19:30
回復
62#
GBKEE
感謝說明~我再試試看!
作者:
starry1314
時間:
2015-5-24 17:10
回復
59#
lpk187
L大~想請問一下
要怎麼最後一行加入windows指令可讓他返回巨集所存在的視窗,或是在哪裡點擊巨集就跳轉回來
Sheets("數據").Select
Range("B27").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("快速輸入").Select
Range("B2") = "=" & ThisWorkbook.Sheets("出餐單").Range("H1").Address(, , , 1)
Range("C3") = "=" & ThisWorkbook.Sheets("出餐單").Range("C5").Address(, , , 1)
Range("D3") = "=" & ThisWorkbook.Sheets("出餐單").Range("L1").Address(, , , 1)
Range("B4") = "=" & ThisWorkbook.Sheets("出餐單").Range("B3").Address(, , , 1)
Range("B5") = "=" & ThisWorkbook.Sheets("出餐單").Range("E1").Address(, , , 1)
複製代碼
作者:
lpk187
時間:
2015-5-25 09:34
本帖最後由 lpk187 於 2015-5-25 09:38 編輯
回復
64#
starry1314
我不知道你原活頁簿的工作表名稱是什麼,我假設它是"出餐單"這的工作表
ThisWorkbook.Sheets("出餐單").Activate
"ThisWorkbook"是原程式所在的活頁簿
作者:
starry1314
時間:
2015-5-25 09:40
回復
65#
lpk187
感謝..原來是少了sheets
原本寫法...ThisWorkbook.Activate
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)