excel - 从用户窗体提交到数据库时，VBA 缩短超链接图像路径

Question

我试图找出单击提交按钮时缩短图像超链接路径的最佳方法。现在，所有用户表单数据和图像文件路径都转到适当的行/列，但它很丑陋。我想了解如何使用 VBA 将文件路径缩短为文件名或将路径更改为完全不同的单词(例如“图像”)。理想情况下，我想用“图像”一词替换超链接，但我不确定这是否可行？

我在这个网站上发现了一些关于创建要调用的函数来缩短路径的想法，但我不确定在将数据提交到数据库时如何使用这些函数。

我当前的代码如下，后面是我发现可以工作的函数。

Private Sub CommandButton1_Click()
Dim TargetRow As Long
Dim linked_path1 As Variant
Dim linked_path2 As Variant

TargetRow = Sheets("Engine").Range("B3").Value + 1 'plus 1 move the row down 1 so it doesn't overrite last row value

Sheets("Database").Range("Data_Start").Offset(TargetRow, 1) = orderid
Sheets("Database").Range("Data_Start").Offset(TargetRow, 2) = ComboBox1
Sheets("Database").Range("Data_Start").Offset(TargetRow, 3) = ComboBox2
Sheets("Database").Range("Data_Start").Offset(TargetRow, 4) = ComboBox3
Sheets("Database").Range("Data_Start").Offset(TargetRow, 5) = TextBox2
Sheets("Database").Range("Data_Start").Offset(TargetRow, 6) = TextBox3

'Set named range and a variable in teh Hyperlink.Add function
Set linked_path1 = Sheets("Database").Range("Data_Start").Offset(TargetRow, 7)
Sheets("Database").Hyperlinks.Add Anchor:=linked_path1, _
Address:=filepath1

Set linked_path2 = Sheets("Database").Range("Data_Start").Offset(TargetRow, 8)
Sheets("Database").Hyperlinks.Add Anchor:=linked_path2, _
Address:=filepath2

Unload UserForm2
End Sub

我在这个网站上找到的功能可以做到这一点 - 这只获取文件名而不是扩展名

Function FileNameNoExtensionFromPath(strFullPath As String) As String

Dim intStartLoc As Integer
Dim intEndLoc As Integer
Dim intLength As Integer

intStartLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "\") - 1)
intEndLoc = Len(strFullPath) - (Len(strFullPath) - InStrRev(strFullPath, "."))
intLength = intEndLoc - intStartLoc

FileNameNoExtensionFromPath = Mid(strFullPath, intStartLoc, intLength)

End Function

非常感谢四月

Answer 1

您可以只使用TextToDisplay hyperlinks.add的属性(property).

Private Sub CommandButton1_Click()

    Dim TargetRow As Long
    Dim linked_path1 As Variant
    Dim linked_path2 As Variant

    TargetRow = Sheets("Engine").Range("B3").Value + 1 'plus 1 move the row down 1 so it doesn't overrite last row value

    With Sheets("Database").Range("Data_Start")

        .Offset(TargetRow, 1) = orderid
        .Offset(TargetRow, 2) = ComboBox1
        .Offset(TargetRow, 3) = ComboBox2
        .Offset(TargetRow, 4) = ComboBox3
        .Offset(TargetRow, 5) = TextBox2
        .Offset(TargetRow, 6) = TextBox3

        'Set named range and a variable in teh Hyperlink.Add function
        Set linked_path1 = .Offset(TargetRow, 7)

    End With

    Sheets("Database").Hyperlinks.Add Anchor:=linked_path1, _
            Address:=filepath1, TextToDisplay:=getfilenamefrompath(filepath1)

    Set linked_path2 = Sheets("Database").Range("Data_Start").Offset(TargetRow, 8)
    Sheets("Database").Hyperlinks.Add Anchor:=linked_path2, _
            Address:=filepath2, TextToDisplay:=getfilenamefrompath(filepath2)

    Unload UserForm2

End Sub

此外，With...End With语句非常适合您的范围偏移组..

啊，差点忘了 - 你仍然需要找出文件名。作为 URL，Split()功能会起作用。我们可以制作一个与您找到的类似的功能。

Function getFileNameFromPath(filePath As String, Optional delim as string = "\") As String

    getFileNameFromPath = Split(filePath, delim)(UBound(Split(filePath, delim)))

End Function

在此函数中，您将拆分 filePath由 delim \ , 两次。第一个是不言自明的，但第二个您只是使用 UBound() 获取分割的最后一个索引。功能。

更新:添加了可选参数 delim因此它可以同时使用 URL(使用 / )和文件路径(使用 \ )。它将默认为 \除非您另外指定。