时间戳

首页 > 解决方案 > 从用户表单提交到数据库时，VBA缩短超链接图像路径

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

问题描述

我试图找出在单击提交按钮时缩短图像超链接路径的最佳方法。现在，所有用户表单数据和图像文件路径都转到相应的行/列，但这很丑陋。我想看看如何使用 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

在此处输入图像描述

非常感谢四月

标签： excelvbaimageuserform

解决方案

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

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（使用/）和文件路径（使用\）。\除非您另外指定，否则它将默认为。

推荐阅读