VBAは、他の動的なワークブック

Question

へのハイパーリンクを作成する私は私の問題の解決策を見つけるのに苦労しています：

私は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 

Answer 1

条件が一致するようにするには、Select Caseを使用してください。

ハイパーリンクにSubAddressを追加すると、正しいシートに到着できるはずです。
名前にスペースがある場合は、シート名の前後に'を追加する必要があります。

そして、ActiveCellまたはSelectで作業するのは避けてください。最も効果的ではありません。あなたが一度に一つの呼び出しでマクロを実行しているように見えるあなたのコードからと代わりに、マクロのハイパーリンクを作成するための式を使用していないのはなぜ

Dim StType As String, FPath As String 
Select Case Left(ActiveCell, 1) 
    Case Is = "B" 
     StType = "Bulk Stock.xlsx" 
    Case Is = "F" 
     StType = "Finished Goods Stock.xlsx" 
    Case Is = "P" 
     StType = "Packaging Stock.xlsx" 
    Case Is = "R" 
     StType = "Raw Mat Stock.xlsx" 
    Case Else 
     MsgBox "Case not handled for type : " & Left(ActiveCell, 1), _ 
       vbOKOnly + vbInformation 
     Exit Sub 
End Select 

FPath = "C:\Users\Reception\Documents\Shared\Item Master Data\Stock\" & StType 

Sheets("Component List").Hyperlinks.Add _ 
    Anchor:=ActiveCell, _ 
    Address:=FPath, _ 
    SubAddress:=ActiveCell.Value & "!A1" 

Answer 2

。

この例では、コードが列Aにあることを前提としています。数式を別の列の最初の行に置き、自動入力してすべてのコードのハイパーリンクを作成します。私はファイルの最初のカップルだけに従っているので、それほど複雑ではないが、他のネストされたifを追加する必要がある。

=IF(LEFT(A1,1)="B",HYPERLINK("C:\Users\Reception\Documents\Shared\Item Master Data\Stock\Bulk Stock.xlsx","Bulk Stock.xlsx"),IF(LEFT(A1,1)="F",HYPERLINK("C:\Users\Reception\Documents\Shared\Item Master Data\Stock\Finished Goods Stock.xlsx","Finished Goods Stock.xlsx"),"")) 

ここではすべての式がすべてネストされています。

=IF(LEFT(A1,1)="B",HYPERLINK("C:\Users\Reception\Documents\Shared\Item Master Data\Stock\Bulk Stock.xlsx","Bulk Stock.xlsx"),IF(LEFT(A1,1)="B",HYPERLINK("C:\Users\Reception\Documents\Shared\Item Master Data\Stock\Bulk Stock.xlsx","Bulk Stock.xlsx"),IF(LEFT(A1,1)="P",HYPERLINK("C:\Users\Reception\Documents\Shared\Item Master Data\Stock\Packaging Stock.xlsx","Packaging Stock.xlsx"),IF(LEFT(A1,1)="R",HYPERLINK("C:\Users\Reception\Documents\Shared\Item Master Data\Stock\Raw Mat Stock.xlsx","Raw Mat Stock.xlsx"),""))))