将 .mpg 文件超链接到 excel 中的单元格

Hyperlinking .mpg files to cells in excel

我有几行一些字符串,我想将它们分配给 mpg 电影。例如“101 Home Visit 33”需要链接到101asd.mpg,前3个字符每次都相同。在一个目录中有超过 50 个 mpg 文件,所以我想制作一个宏,使用 ctrl+h 自动执行(我的意思是搜索和超链接)。我不知道如何搜索文件名。为了方便起见,我创建了仅包含前三个字符 (101) 的第二列,并将其命名为 file_number 我的代码:

Sub Makro1()
'Dim i As Integer
Dim cell_name As String
Dim file_name As String
Dim file_number As String

ActiveCell.Select
cell_name = ActiveCell.Value

ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.Select

file_number = ActiveCell.Value

ActiveCell.Offset(0, -2).Range("A1").Select
ActiveCell.Select

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    file_number & "*.mpeg", TextToDisplay:= _
    file_name


End Sub

这部分有问题:

file_number & "*.mpeg", TextToDisplay:= _
    file_name

或者更准确地说

"*.mpeg" 

因为我试图用 *.

覆盖一些字符

怎么了?

连同讨论的其他内容,如果它们都在同一个文件中,您可以将工作簿路径存储为一个变量以供参考:

Sub Makro1()
'All Your Other Stuff

Dim strPath As String

strPath = ActiveWorkbook.Path

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    strPath & "\" & file_number & ".mpeg", TextToDisplay:= _
    file_name
'TextToDisplay may be cell_name depending on how you adjusted your code.

End Sub

不使用*就解决了问题。我尝试了不同的方法,但 none 成功了。

Sub Makro1()

For Each cell In Selection

If cell.Value = "" Then

Else
Call linkowanie
End If

ActiveCell.Offset(1, 0).Range("A1").Select 'Jump to lower cell
Next cell


End Sub

Sub linkowanie()

Dim cell_name As String
Dim file_number As String
Dim strPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim k As Integer

Dim file_names() As String 'Dynamic array for file names

strPath = ActiveWorkbook.Path 'Path shows way to excel file

ActiveCell.Select
cell_name = ActiveCell.Value

ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.Select

file_number = ActiveCell.Value

ActiveCell.Offset(0, -2).Range("A1").Select
ActiveCell.Select

strPath = ActiveWorkbook.Path

Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an       instance of the FileSystemObject

Set objFolder = objFSO.GetFolder(strPath) 'Get the folder object

 i = 0

For Each objFile In objFolder.Files
ReDim Preserve file_names(i)
file_names(i) = objFile.Name
i = i + 1
Next objFile

For k = 0 To i - 1
If Mid(file_names(k), 1, 6) = file_number Then
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    strPath & "\" & file_names(k), TextToDisplay:= _
    cell_name
End If
Next k


End Sub