へのハイパーリンクを作成する私は私の問題の解決策を見つけるのに苦労しています:VBAは、他の動的なワークブック
私は1つのワークブックと異なるスプレッドシート上の各項目のシートを作成したマクロの項目のリストを持っています。
列Aの各コードは、最初のレターとして製品のタイプを持ち、各製品タイプは独自のワークブックを取得します。
ハイパーリンクを除いて、すべてのコードは正常に動作します。
シートを作成するときに、各コードをハイパーリンクする必要があります。
実行すると、C:\ Users \ Reception \ Documents \ Shared \ Item Master Data \ Stock \に自分のセルがハイパーリンクされ、シートが開かれません。
私には何が欠けていますか?私のFULLコードは以下の通りです。
Sub StockSheets()
Sheets("Component List").Select
Range("A2").Select 'Start with first item code'
Do Until ActiveCell = " "
GoTo Openwb 'check if wbStock is already open'
NewType: 'if wbStock is not open'
Dim StType As String, wbStock As Workbook, wsTEMP As Worksheet
If Left(ActiveCell, 1) = "B" Then
StType = "Bulk Stock.xlsx"
Else
If Left(ActiveCell, 1) = "F" Then
StType = "Finished Goods Stock.xlsx"
Else
If Left(ActiveCell, 1) = "P" Then
StType = "Packaging Stock.xlsx"
Else
If Left(ActiveCell, 1) = "R" Then
StType = "Raw Mat Stock.xlsx"
End If
End If
End If
End If
Set wbStock = Workbooks.Open("C:\Users\Reception\Documents\Shared\Item Master Data\Stock\" & StType)
Resume Cont1 'skip Openwb part'
Openwb:
On Error GoTo NewType 'Open wbStock'
wbStock.Activate
Cont1:
Set wsTEMP = Sheets("Stock Template")
wsTEMP.Copy After:=Sheets(Sheets.Count) 'Copies the Stock template to a new sheet'
Sheets(Sheets.Count).Activate
Application.Workbooks("Item Master Data.xlsm").Activate
Worksheets("Component List").Select
On Error GoTo Exist 'if Sheetname exists'
wbStock.Worksheets("Stock Template (2)").Name = ActiveCell.Value 'Name the new sheet as per the active cell on Component List'
wbStock.Activate
Range("A1:B1").Copy
Range("A1:B1").PasteSpecial Paste:=xlPasteValues 'Paste the formulas as values to speed up computer'
Range("A:J").Select
Columns.AutoFit 'neaten the sheet'
ThisWorkbook.Activate 'Go back to Item Master Data workbook with Component list'
Dim FPath As String
FPath = "C:\Users\Reception\Documents\Shared\Item Master Data\Stock\" & StType
Sheets("Component List").Hyperlinks.Add Anchor:=Excel.Selection, _
Address:="C:\Users\Reception\Documents\Shared\Item Master Data\Stock\" & StType & "#" & ActiveCell.Value & "!A1" 'Hyperlink item code to newly created sheet on wbStock'
Cont2:
If Left(ActiveCell.Offset(1, 0), 1) = Left(ActiveCell, 1) Then
Resume Cont3 'Check if next stType is the same as the Active Cell'
Else
wbStock.Close True 'Save and close wbStock'
End If
Cont3:
ActiveCell.Offset(1, 0).Select 'Select next item'
Loop
Exist: 'If the sheet already exists'
Sheets("Componet List").Hyperlinks.Add Anchor:=Selection, _
Address:=wbStock.Worksheets(ActiveCell).Range("A1")
Application.DisplayAlerts = False
Worksheets("Stock Template (2)").Delete
Application.DisplayAlerts = True 'Delete the newly created sheet before looping with the next item'
Resume Cont2
ActiveSheet.Cells.Font.Size = 10 'Neaten Sheet'
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Borders
.LineStyle = xlContinuous
.Color = 0
.Weight = xlThin
End With
With Columns("A:ZZ").AutoFit
Range("A1").Select
End With
End Sub
問題は何ですか?あなたはハイパーリンクをセルに追加しています。ワークブックを開くことを目的としている場合は、workbooks.open(fpath)を実行します。 *編集*:あなたの意図がカスタム範囲の各セルをハイパーリンクしているなら、あなたが使っていると仮定しているループ全体を投稿します。 – Zerk
C:\ Users \ Reception \ Documents \ Shared \ Item Master Data \ Stock \にしかリンクしていない場合、変数StTypeを設定する基準が満たされていないため、変数が空です。コードがActiveCellをチェックしているので、マクロを実行するときに選択したセルに、ハイパーリンクを設定するコードが含まれていることを確認する必要があります。 – Gordon