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

enter image description here

Огромное спасибо апрель

Эта функция, которую вы «схватили», буквально называется FileNameNoExtensionFromPath. Вы пробовали изменить его на FileNameWithExtensionFromPath?

user4039065 26.10.2018 05:14
3
1
194
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Вы можете просто использовать свойство 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 разделителем \. Первый не требует пояснений, но второй вы просто захватываете последний индекс разделения с помощью функции UBound().

Обновлять: Добавлен необязательный аргумент delim, чтобы он работал как с URL-адресами (с использованием /), так и с путями к файлам (с использованием \). По умолчанию он будет \, если вы не укажете иное.

Вот это да!!! Вы изменили мою жизнь, научившись использовать With / EndWith! Я все время делал это тяжело! И ваше решение прекрасно сработало! Мне удалось все настроить с первого раза. Я так счастлив, база данных выглядит намного лучше. Большое спасибо за подробный ответ. Ты сегодня многому меня научил!

April Parker 26.10.2018 17:47

Рад помочь @AprilParker!

K.Dᴀᴠɪs 26.10.2018 18:10

Другие вопросы по теме