Question

我有几行字符串，我想将它们分配给mpg电影。例如＆＃34; 101 Home Visit 33＆＃34;需要与101asd.mpg链接，前3个字符每次都相同。在一个目录中有超过50英里/加仑的文件，所以我有一个想法，通过使用 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"

因为我试图用*。

覆盖一些角色

有什么问题？

Answer 1

除了讨论的其他内容之外，如果它们都在同一个文件中，您可以将工作簿路径存储为引用变量：

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

Answer 2

问题在不使用*的情况下解决。我尝试过不同的方式，但没有一个工作。

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文件超链接到excel中的单元格

2 个答案: