ขอคำแนะนำเรื่อง Hyperlink ใน VBA

[9KiTTi]

ขออนุญาตขอคำแนะนำเรื่อง Hyperlink ใน VBA โดยผมต้องการสร้าง hyperlink จากชื่อ sheet ตั้งแต่ชีทที่ A1 เป็นต้นไป และยกเว้นชีทชื่อ Main แต่ code ที่ผมมีจะสร้างชื่อชีททั้งหมด ขอคำแนะนำในการปรับแก้ไขด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub Createhyper()
    Dim sh As Worksheet
    Dim wSheet As Worksheet
    Sheets("Main").Range("B6").Select
    Application.ScreenUpdating = False
    For Each wSheet In Worksheets
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & wSheet.Name & "'" & "!B6", TextToDisplay:=wSheet.Name
        ActiveCell.Offset(1, 0).Select
    Next
    Application.ScreenUpdating = True
End Sub

[puriwutpokin]

ปรับตามนี้ครับ

Code: Select all

Sub Createhyper()
    Dim sh As Worksheet
    Dim wSheet As Worksheet
    Sheets("Main").Range("B6").Select
    Application.ScreenUpdating = False
    For Each wSheet In Worksheets
    If wSheet.Name <> "Main" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & wSheet.Name & "'" & "!B6", TextToDisplay:=wSheet.Name
        ActiveCell.Offset(1, 0).Select
    End If
    Next
    Application.ScreenUpdating = True
End Sub

[9KiTTi]

ปรับตามนี้ครับ

Code: Select all

Sub Createhyper()
    Dim sh As Worksheet
    Dim wSheet As Worksheet
    Sheets("Main").Range("B6").Select
    Application.ScreenUpdating = False
    For Each wSheet In Worksheets
    If wSheet.Name <> "Main" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & wSheet.Name & "'" & "!B6", TextToDisplay:=wSheet.Name
        ActiveCell.Offset(1, 0).Select
    End If
    Next
    Application.ScreenUpdating = True
End Sub

ขอบพระคุณครับ แต่ยังนำเข้าชื่อชีท X1-X4 อยู่ครับ ผมอยากให้แสดงแค่แสดงชื่อชีท A1 เป็นต้นไปครับ

[puriwutpokin]

ปรับตามนี้ครับ

Code: Select all

Sub Createhyper()
    Dim i As Integer
    Sheets("Main").Range("B6").Select
    Application.ScreenUpdating = False
    For i = 6 To Sheets.Count
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _
        SubAddress:="'" & Sheets(i).Name & "'" & "!B6", TextToDisplay:=Sheets(i).Name
        ActiveCell.Offset(1, 0).Select
    Next i
    Application.ScreenUpdating = True
End Sub

[9KiTTi]

ขอบพระคุณมากครับ สามารถใช้งานได้แล้วครับ