Question

我正在努力为我的问题找到解决方案：

我有一个工作簿上的项目列表和一个宏，它为不同电子表格中的每个项目创建工作表。

A列中的每个代码都将产品类型作为第一个字母，每个产品类型都有自己的工作簿。

除超链接外，所有代码都可以正常工作。

我需要在创建表单时将每个代码超链接到工作表。

运行时，它会将我的单元格超链接到“C：\ Users \ Reception \ Documents \ Shared \ Item Master Data \ Stock \”，而不是打开我的工作表。

我错过了什么？我的完整代码如下。

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列中。将公式放在另一列的第一行中，然后自动填充以创建所有代码的超链接。我只包含了前几个文件，因此它不会太复杂，但您只需要添加其他嵌套ifs。

=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"),""))))

VBA创建指向另一个动态工作簿的超链接

2 个答案: