彰化一整天的論壇

 找回密碼
 立即註冊
查看: 531|回復: 5

利用Excel做大量改檔案名稱中帶入檔案超連結

[複製鏈接]
發表於 2017-6-15 10:32:31 | 顯示全部樓層 |閱讀模式
彰化一整天老師,您好!
請教我在您的網站抓取了您的程式
:如何利用Excel做大量改檔案名稱
內部我想修改匯入檔名時一併新增該檔名的超連結讓我在改檔名前能把檔案打開看內容,請問語法要如何修改呢?
目前我能做到的就是修改內部巨集添加超連結在選擇原本的資料夾但是無法直接打開該檔案。

我自己新增了一個超連結

/////////////////////////////////////////////
Public Sub 選取要改的檔案名稱()
     Dim fd As FileDialog    '宣告一個檔案對話框
     Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
     fd.Filters.Clear    '清除之前的資料
     fd.InitialFileName = Excel.ActiveWorkbook.Path  '設定預設目錄
     fd.Filters.Add "Pdf File", "*.pdf*" '設定顯示的副檔名 我直接改只能選擇Pdf
     fd.Filters.Add "所有檔案", "*.*"
     fd.Show '顯示對話框
     'Sheet1.Range("A4:B" & Excel.Rows.Count).Clear '將舊的A-B欄資料清除
    startx = Excel.WorksheetFunction.CountA(Range("A2:A" & Excel.Rows.Count))     '已選取檔案數
     For i = 1 To fd.SelectedItems.Count
         strFullName = fd.SelectedItems(i)
         n = rinstr(strFullName, "\")  
         strFileNameType = Mid(strFullName, n + 1)
         Sheet1.Cells(i + 1 + startx, 1) = strFileNameType
End Sub
1. 感謝您的回信但是請問老師我應該何處新增語法超連結才能直接點開超連結時自己打開Pdf檔?
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= strFileNameType  '只有單一筆超連結成功"

最終希望一次選擇多筆資料希望能直接帶出相對應的超連結






回復

使用道具 舉報

發表於 2017-6-15 11:38:05 | 顯示全部樓層
您可以上傳您改過的excel程式嗎?
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-6-15 14:55:26 | 顯示全部樓層
imingho 發表於 2017-6-15 11:38
您可以上傳您改過的excel程式嗎?

您好! 請參考

rename.xls

45.5 KB, 下載次數: 80

回復 支持 反對

使用道具 舉報

發表於 2017-6-15 15:20:41 | 顯示全部樓層

您是不是上傳錯檔案了.這是我原本的程式,裡面沒看到您寫的程式碼.
回復 支持 反對

使用道具 舉報

發表於 2017-6-15 15:23:28 | 顯示全部樓層
imingho 發表於 2017-6-15 15:20
您是不是上傳錯檔案了.這是我原本的程式,裡面沒看到您寫的程式碼.

我用您email的檔案改給您看.
  1. Public Sub cmdSelectFile()
  2.     Dim fd As FileDialog    '宣告一個檔案對話框
  3.    
  4.     Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
  5.    
  6.    
  7.     fd.Filters.Clear    '清除之前的資料
  8.    
  9.     fd.InitialFileName = Excel.ActiveWorkbook.Path  '設定預設目錄
  10.    
  11.     fd.Filters.Add "Excel File", "*.xls*" '設定顯示的副檔名
  12.     fd.Filters.Add "Word File", "*.txt"
  13.     fd.Filters.Add "Word File", "*.csv"
  14.     fd.Filters.Add "所有檔案", "*.*"
  15.    
  16.     fd.Show '顯示對話框
  17.    
  18.     'Sheet1.Range("A4:B" & Excel.Rows.Count).Clear '將舊的A-B欄資料清除
  19.     startx = Excel.WorksheetFunction.CountA(Range("A2:A" & Excel.Rows.Count))     '已選取檔案數
  20.    
  21.     For i = 1 To fd.SelectedItems.Count
  22.         strFullName = fd.SelectedItems(i)
  23.         n = rinstr(strFullName, "\")
  24.         
  25.         strFileNameType = Mid(strFullName, n + 1)
  26.         
  27.         Sheet1.Cells(i + 1 + startx, 1) = strFileNameType
  28.         
  29.                '加入超連結,只能一筆一筆加入,一次匯入多個檔案就無法使用
  30.         ActiveSheet.Hyperlinks.Add Anchor:=Sheet1.Cells(i + 1 + startx, 1), Address:=strFullName
  31.         
  32.     Next
  33.   
  34. End Sub
複製代碼


rename.xls

46.5 KB, 下載次數: 4

售價: 1 金錢  [記錄]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-6-15 21:18:48 | 顯示全部樓層
太太太感謝了~~
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-10-17 09:00 , Processed in 0.132107 second(s), 22 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表