VBA сокращает путь к гиперссылке при передаче в базу данных из пользовательской формы - PullRequest
Новая
       9

VBA сокращает путь к гиперссылке при передаче в базу данных из пользовательской формы

0 голосов
/ 26 октября 2018

Я пытаюсь найти лучший способ сократить пути гиперссылок в моем изображении при нажатии кнопки отправки. Прямо сейчас все пути к пользовательским данным и файлам изображений идут в соответствующие строки / столбцы, но это ужасно. Я хочу посмотреть, как использовать 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

Большое спасибо Апрель

1 Ответ

0 голосов
/ 26 октября 2018

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

...