Как переименовать изображения, гиперссылки в Excel по содержанию в столбце

Question

У меня есть список Excel с большим количеством строк, например. «$ FB9275» в столбце A, а многие изображения, гиперссылки в столбце B, хранятся в папке со странным именем, например «4e584a1c6911». И я хочу переименовать изображения, гиперссылки в столбце B, по содержанию в столбце A. I ' m первокурсник, спасибо! sheet

Answer 1

добавить в проект ссылку на библиотеку "Microsoft Scripting Runtime" для того, чтобы использовать FileSystemObject объект

затем использовать этот код:

Option Explicit 

Sub main() 
    Dim cell As Range 
    Dim currenthWbPath As String, oldName As String 
    Dim fso As New FileSystemObject 
    Dim file As file 
    Dim hyp As Hyperlink 

    With ActiveWorkbook '<--| refer to currently active workbook 
     currenthWbPath = .Path '<--| store its full path 
     With .Worksheets("pics") '<--| refer to its "pics" worksheet (change it as per your needs) 
      For Each cell In .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants) '<--| loop through referenced sheet column "B" cells with values in it 
       If cell.Hyperlinks.Count > 0 Then '< if current cell contains a hyperlink 
        Set hyp = cell.Hyperlinks.Item(1) '<-- stote the first hyperlink object associated to the cell 
        If fso.FileExists(currenthWbPath & "\" & hyp.Address) Then '<--| if the hyperlink leads to an existent file 
         Set file = fso.GetFile(currenthWbPath & "\" & hyp.Address) '<--| get the file corresponding to hyperlink 
         oldName = file.name '<-- store old name 
         file.name = cell.Offset(, -1) & "." & fso.GetExtensionName(file.Path) '<--| rename the file 
         hyp.Address = Replace(hyp.Address, oldName, file.name) '<--| refresh hyperlink address 
         hyp.TextToDisplay = cell.Hyperlinks.Item(1).Address '<--| refresh hyperlink text to display 
        Else 
         ' code to deal with invalid hyperlinks 
        End If 
       End If 
      Next cell 
     End With 
    End With 
End Sub