将 .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
我有几行一些字符串,我想将它们分配给 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