0

画像ファイルへのハイパーリンクのリストの作成を自動化しようとしています。私のワークシートには列 A にファイル名がリストされており、それらのファイル (ワークシートの親フォルダーに保存されている) へのハイパーリンクを列 B に配置したいです。私は VBA の初心者ですが、これはかなり単純なはずですが、これを行う方法を見つけるために。

Macro Recorder を使用してみましたが、次のようになりました。

    Sub Hyperlink()
'
' Hyperlink Macro
'
' Keyboard Shortcut: Ctrl+l
'
    ActiveCell.Offset(0, -1).Range("Table1[[#Headers],[ACTIVITY '#]]").Select
    ActiveCell.FormulaR1C1 = "file(a)"
    ActiveCell.Offset(0, 1).Range("Table1[[#Headers],[ACTIVITY '#]]").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "..\file(a).JPG", TextToDisplay:="..\file(a).JPG"
    ActiveCell.Offset(1, 0).Range("Table1[[#Headers],[ACTIVITY '#]]").Select
End Sub

どんな助けでも大歓迎です。乾杯。

4

1 に答える 1

0

セルをループしてハイパーリンクを作成し、データを保持する列を参照するだけです。

Sub CreateJpgHyperLinks()
Dim iRow, iCol As Integer 'row and column counters

iRow = 1 'change to 2 if there are headers
iCol = 1 'Column A
    'this assumes there is data in all cells in column A
    Do While ActiveSheet.Cells(iRow, iCol).Value <> ""
        'set the link in column B and point it to the info in column A
        ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(iRow, iCol + 1), Address:=ActiveSheet.Cells(iRow, iCol).Value, _
        TextToDisplay:=ActiveSheet.Cells(iRow, iCol).Value
        'move to the next row
        iRow = iRow + 1
    Loop

End Sub

フォルダーを見つけるには、以下の方法を使用できます

'get path to current workbook
workbookPath = ActiveWorkbook.Path
'find the last slash in the workbook path
iLastFolderSlash = InStrRev(workbookPath, "\")
'create the folder location by removing the last folder from the path
jpgFolderPath = Left(workbookPath, iLastFolderSlash)
于 2013-04-22T22:36:33.330 に答える