12
返回列表 上一主題 發帖

[發問] 關於自動開啟指定位置檔案or超連結路徑的檔案

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-6-3 15:47 | 只看該作者

[發問] 關於自動開啟指定位置檔案or超連結路徑的檔案

本帖最後由 starry1314 於 2015-6-3 15:49 編輯

如何加入以下指令呢? 因我加進Dim wsTarget As Worksheet
底下 好像會造成按鈕行不對 所以沒辦法判斷~
或是要怎麼設定成指定路徑然後檔名,可以讀取儲存格的檔名做變數呢?

去數據表格 點選B22的超連結 開啟客戶明細
  Sheets("數據").Select
    Range("B22").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
  1. Sub 貼上資料至_客服管理_自動判斷()
  2. '
  3. ' 貼上資料至_客服管理 巨集
  4.     Dim lSourceRow As Long, lTargetRow As Long
  5.     Dim wsTarget As Worksheet
  6.     With ActiveSheet
  7.         lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被點擊的該按鈕行數
  8.         If .Cells(lSourceRow, "C").Text = vbNullString Then MsgBox "日期欄無資料，無法判斷貼上月份": Exit Sub
  9.         Set wsTarget = Workbooks("客戶明細-業務專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "C"))) '日期判斷要貼上的工作表
  10.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '要貼上的位置
  11.         Application.ScreenUpdating = False
  12.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy '複製A欄到P欄的資料
  13.         wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues '在B欄開始貼上
  14.         wsTarget.Paste Link:=True '貼上連結
  15.         Application.ScreenUpdating = True '貼上連結
  16.     End With
  17.    
  18.     With wsTarget
  19.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
  20.                         Address:=ThisWorkbook.FullName, _
  21.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
  22.                      TextToDisplay:=.Cells(lTargetRow, "a").Text

  24.     End With
  25. End Sub
複製代碼
收藏 分享

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
2#
發表於 2015-6-4 00:12 | 只看該作者
如何加入以下指令呢? 因我加進Dim wsTarget As Worksheet
底下 好像會造成按鈕行不對 所以沒辦法判斷~
或 ...
starry1314 發表於 2015-6-3 15:47
  1. Dim wsTarget As Worksheet
  2. '===== 加底下這些指令=====
  3. Dim sPath$

  5. sPath = ThisWorkbook.Path
  6. ChDrive sPath
  7. ChDir sPath
  8. '===== 加上面這些指令=====
  9.     With ActiveSheet
複製代碼

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
3#
發表於 2015-6-4 15:47 | 只看該作者
已加入 但會跳出 執行程需或呼叫錯誤
  1. Sub 貼上資料至_客服管理_自動判斷()
  2. '
  3. ' 貼上資料至_客服管理 巨集
  4.     Dim lSourceRow As Long, lTargetRow As Long
  5.     Dim wsTarget As Worksheet
  6.     Dim sPath$

  8. sPath = ThisWorkbook.Path
  9. ChDrive sPath
  10. ChDir sPath
  11.     With ActiveSheet
  12.         lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被點擊的該按鈕行數
  13.         If .Cells(lSourceRow, "C").Text = vbNullString Then MsgBox "日期欄無資料，無法判斷貼上月份": Exit Sub
  14.         Set wsTarget = Workbooks("客戶明細-客服專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "C"))) '日期判斷要貼上的工作表
  15.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '要貼上的位置
  16.         Application.ScreenUpdating = False
  17.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "AF")).Copy '複製A欄到P欄的資料
  18.         wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues '在B欄開始貼上
  19.        wsTarget.Paste Link:=True '貼上連結
  20.         Application.ScreenUpdating = True '貼上連結
  21.     End With
  22.    
  23.     With wsTarget
  24.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
  25.                         Address:=ThisWorkbook.FullName, _
  26.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
  27.                      TextToDisplay:=.Cells(lTargetRow, "a").Text

  29.     End With
  30. End Sub
複製代碼
回復 2# luhpro

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
4#
發表於 2015-6-5 23:25 | 只看該作者
已加入 但會跳出 執行程需或呼叫錯誤
回復  luhpro
starry1314 發表於 2015-6-4 15:47

我提供的指令若發生錯誤,
原因大部分應該都是 "找不到路徑" 才對.

你的程式乍看之下看不出來錯誤在哪裡,
你試試按下 "偵錯" 按鈕,
看看是哪一行發生此錯誤.

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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

這一段,麻煩看看囉~
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被點擊的該按鈕行數

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
6#
發表於 2015-6-6 00:15 | 只看該作者
回復  luhpro

這一段,麻煩看看囉~
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '被 ...
starry1314 發表於 2015-6-5 23:48

指令對象與呼叫方式都不正確喔 :
Caller 屬性
傳回關於呼叫 Visual Basic 的資訊 (詳細內容請參閱 [備註] 部份)。

expression.Caller(Index)
expression    必選。此運算式會傳回 Application 物件。

Index    選擇性的 Variant。陣列的索引。僅當本屬性傳回陣列時此引數才有用 (詳細內容請參閱 [備註] 部份)。

備註
本屬性將傳回關於呼叫 Visual Basic 的資訊，如下表所示。

呼叫者                                                                                                                 傳回值
在單一儲存格中輸入的自訂函數                                                                     代表該儲存格的 Range 物件
在儲存格範圍中作為陣列公式一部份的自訂函數                                         代表該儲存格範圍的 Range 物件
Auto_Open、Auto_Close、Auto_Activate 或 Auto_Deactivate 巨集  以文字模式傳回的文件名稱
由OnDoubleClick 或 OnEntry 屬性所設定的巨集                                      該巨集所套用的圖表物件辨識符號或儲存格參照 (若適用) 的名稱
[工具] 功能表中的 [巨集] 對話方塊，或上述之外的其他呼叫者                #REF! 錯誤值

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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


    這邊真的看不懂...因為原本程式是正常運作的
只是按鈕必須放在要複製的資料 同一行 才有辦法複製,
但現在是在另外一個頁面做按鈕呼叫此巨集但就沒辦法執行了.有先讓巨集1去先點要複製資料的那一行 再呼叫此自動複製資料的巨集 但還是無法完成

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
8#
發表於 2015-6-6 00:30 | 只看該作者
本帖最後由 luhpro 於 2015-6-6 00:36 編輯
回復  luhpro
    這邊真的看不懂...因為原本程式是正常運作的
只是按鈕必須放在要複製的資料 同一行 ...
starry1314 發表於 2015-6-6 00:27

你不用這樣設計啊.

如果要區分的是按鈕:
只要設定一個全域變數,
接著在每一個按鈕的 Click 處理程序區塊內各別設定此變數不同的值,
就可以區分了.

如果要區分的是被選取的儲存格:
Selection(1).Address 可取得 $A$2 形式的儲存格位址
Selection(1).Row 取得其列號
Selection(1).Column 取得其欄號
用 (1) 是只取左上角那一個儲存格,
避開多選時儲存格目標太多的情形.

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

帖子
471 
主題
121 
精華
0 
積分
579 
點名
0  
作業系統
WIN10 
軟體版本
OFFICE2019 
閱讀權限
50 
性別
男 
註冊時間
2015-4-16 
最後登錄
2023-1-17 
9#
發表於 2015-6-6 01:09 | 只看該作者
回復 8# luhpro
目前改至以下模式
但在        wsTarget.Cells(lSourceRow, "B").PasteSpecial Paste:=xlPasteValues '在B欄開始貼上 會出錯 找不出該怎麼修改
  1. Sub 貼上資料至_客服管理_自動判斷()
  2. '
  3. ' 貼上資料至_客服管理 巨集
  4.     Dim lSourceRow As Long, lTargetRow As Long
  5.     Dim wsTarget As Worksheet
  6.     Dim sPath$

  8.     sPath = ThisWorkbook.Path
  9.     ChDrive sPath
  10.     ChDir sPath
  11.     With ActiveSheet
  12.      lSourceRow = Selection(1).Row + 2 '被點擊的該按鈕行數
  13.      Windows("客戶明細-客服專用.xlsm").Activate
  14.      Sheets("一月").Select
  15.      endRow = ActiveSheet.UsedRange.Cells(Rows.Count, "B").End(xlUp).Row + 1
  16.         Application.ScreenUpdating = False
  17.         .Range(.Cells(endRow, "A"), .Cells(endRow, "AF")).Copy '複製A欄到P欄的資料
  18.         wsTarget.Cells(lSourceRow, "B").PasteSpecial Paste:=xlPasteValues '在B欄開始貼上
  19.        wsTarget.Paste Link:=True '貼上連結
  20.         Application.ScreenUpdating = True '貼上連結
  21.     End With
  22.    
  23.     With wsTarget
  24.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
  25.                         Address:=ThisWorkbook.FullName, _
  26.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
  27.                      TextToDisplay:=.Cells(lTargetRow, "a").Text

  29.     End With
  30. End Sub
複製代碼

TOP

starry1314
　暱稱: 豪

高中生Rank: 3Rank: 3

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

回復 8# luhpro
真是太感謝幫忙了~解決掉我好幾個困擾的問題
已正常運作 ,但紅字部分有點冗長,可幫忙做優化嗎?
因沒加Windows("客戶明細-客服專用.xlsm").Activate
        Sheets("一月").Select
會在原本頁面做貼上資料的動作

另想請問一開始給我的
   sPath = ThisWorkbook.Path
ChDrive sPath
ChDir sPath
作用是? 因用監看式看不懂,嘗試把他拿掉還是正常運作

Sub 貼上資料()
'

    Dim lSourceRow As Long, lTargetRow As Long
    Dim wsTarget As Worksheet
    With ActiveSheet
        lSourceRow = Selection(1).Row  '被點擊的該按鈕行數
       ' If .Cells(lSourceRow, "C").Text = vbNullString Then MsgBox "日期欄無資料，無法判斷貼上月份": Exit Sub
        'Set wsTarget = Workbooks("客戶明細-業務專用.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "C"))) '日期判斷要貼上的工作表
        Set wsTarget = Workbooks("客戶明細-客服專用.xlsm").Sheets(.cells("一月")
        Windows("客戶明細-客服專用.xlsm").Activate
        Sheets("一月").Select
        lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1 '要貼上的位置
        Application.ScreenUpdating = False
        .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "AF")).Copy '複製A欄到P欄的資料
        wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues '在B欄開始貼上
        wsTarget.Paste Link:=True '貼上連結
        Application.ScreenUpdating = True '貼上連結
    End With
   
    With wsTarget
        .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
                        Address:=ThisWorkbook.FullName, _
                        SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
                     TextToDisplay:=.Cells(lTargetRow, "a").Text

    End With
End Sub

TOP

        靜思自在 : 我們要做好社會的環保，也要做好內心的環保。
12
返回列表 上一主題