Staram się znaleźć rozwiązanie dla mojego problemu:

Mam listę przedmiotów w jednym skoroszycie i makro, które tworzy arkusz dla każdego elementu na różnych arkuszach kalkulacyjnych.

Każdy kod w kolumnie A ma rodzaj produktu, co pierwsza litera i każdy typ produktu otrzymuje swój własny skoroszyt.

Wszystkie kody działają dobrze, z wyjątkiem hiperłącza.

Muszę hiperłączyć każdy kod do arkusza, gdy zostanie utworzony.

Po uruchomieniu, hiperłącza moje komórki do "C: Użytkownicy Recepcja Dokumenty Udostępnione dane Master Data Stock" Nie otwierając mojego arkusza.

Czego mi brakuje? Mój pełny kod jest następujący.

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
1
XPCS 17 luty 2017, 15:51

2 odpowiedzi

Najlepsza odpowiedź

Powinieneś użyć Select Case, aby upewnić się, że Twoje kryteria są dopasowaniem.

Dodanie SubAddress w hiperłącze powinno pozwolić na dotarcie na prawym arkuszu.
Jeśli w pewnej nazwie jest spacje, musisz dodać ' wokół nazwy arkusza.

I powinieneś unikać pracy z ActiveCell lub Select nie są to najmniej skuteczne.

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"
0
R3uK 17 luty 2017, 13:15

Dlaczego nie użyjesz formuły, aby utworzyć hiperłącza zamiast makro, jak z kodu wygląda na to, że prowadzisz makro na jednym połączeniu na raz.

Ten przykład zakłada, że kod jest w kolumnie A. Umieść formułę w pierwszym rzędzie kolejnej kolumny, a następnie autofilla w dół, aby utworzyć hiperłącza wszystkich kodów. Włączyłem tylko pierwszą parę plików, aby nie było zbyt skomplikowane, aby naśladować, ale wystarczy dodać inne zagnieżdżone 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"),""))

Oto cała formuła we wszystkich jest zagnieżdżonych chwale.

=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"),""))))
0
Gordon 17 luty 2017, 13:20