VBA 从用户表单提交到数据库时缩短超链接图像路径

Question

我正在尝试找出在单击提交按钮时缩短图像超链接路径的最佳方法。现在，所有用户窗体数据和图像文件路径都转到它们适当的 rows/columns 但这很丑陋。我想看看如何使用 VBA 将文件路径缩短为文件名或将路径更改为完整的不同单词，如 "image"。理想情况下，我想用 "image" 一词替换超链接，但我不确定是否可行？

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

下面是我当前的代码，后面是我发现可以运行的函数。

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

您可以只使用 hyperlinks.add 的 TextToDisplay 属性。

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

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

更新： 添加了 delim 的可选参数，因此它适用于 URLs（使用 /）和文件路径（使用 \）。除非您另外指定，否则它将默认为 \。

VBA 从用户表单提交到数据库时缩短超链接图像路径

VBA Shorten Hyperlink Image path when submitting to a database from a Userform

excel

vba

image

userform