Edit hyperlink ให้เปลี่ยนตามเดือน

[March201711]

ใน sheet แต่ละ sheet มี ปุ่มกดให้ไปที่จุดตั้งต้น เช่น ถ้า sheet เดือน Feb กดปุ่มสีฟ้า จะกลับไปที่ sheet Jan
จะมีวิธีเขียน code vba อย่างไรคะ เพราะ ปุ่มกดมีเป็น 50 กว่า ปุ่ม ต้องมาเปลี่ยนทุกเดือน ไปที่ edit hyperlink ทำให้เสียเวลามากค่ะ

Code: Select all

    Sheets("Feb").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    Range("H6").Select

[March201711]

เอกสารแนบค่ะ

[snasui]

แนบไฟล์ที่มีนามสกุลเป็น .xlsm ซึ่งมี Code ในความเห็น #1 อยู่ด้วยจะได้สะดวกต่อการทดสอบครับ

[March201711]

ถ้าไม่ใช้เป็น code vba จะมีวิธีอื่นไหมค่ะ

[snasui]

ใน sheet แต่ละ sheet มี ปุ่มกดให้ไปที่จุดตั้งต้น เช่น ถ้า sheet เดือน Feb กดปุ่มสีฟ้า จะกลับไปที่ sheet Jan
จะมีวิธีเขียน code vba อย่างไรคะ เพราะ ปุ่มกดมีเป็น 50 กว่า ปุ่ม ต้องมาเปลี่ยนทุกเดือน ไปที่ edit hyperlink ทำให้เสียเวลามากค่ะ

Code: Select all

    Sheets("Feb").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange.Item(1).Hyperlink.Address = ""
    Range("H6").Select

ในไฟล์แนบไม่พบว่ามี Code ครับ ที่อธิบายมายังไม่กระจ่าง ช่วยแจ้งมาว่าปุ่มสีฟ้าอยู่ตำแหน่งใด ได้กำหนด Code ไว้อย่างไร ควรระบุให้เข้าถึงวัตถุ ชีต เซลล์ ที่มีอยู่จริงครับ

[March201711]

แก้ไขfileให้ใหม่แล้วค่ะ

[snasui]

ช่วยสรุปอีกทีว่าต้องการจะทำอะไรครับ

แจ้งมาว่าต้องการคลิกปุ่มไหน แล้วต้องการให้แสดงผลอย่างไร

[March201711]

ต้องดารให้กดปุ่มสีฟ่าค่ะ แล้วไปcheck ที่ sheet mar จากนั้นไปclickที่ปุ่ม A10 สีส้ม ดูว่า hyperlink ไปที่ cell A10 sheet mar หรือไม่
แต่เท่าที่ทำแล้ว มันวิ่งที่ sheet jan cell A10 ค่ะ

[snasui]

ไม่ทราบว่าสร้าง Object ต่าง ๆ ด้วยวิธีใดถึงกลายเป็นชื่อเดียวกันไปได้ ปกติแล้ว Object แม้จะเป็นชนิดเดียวกันก็จะได้ชื่อที่ต่างกันครับ

วิธีการแก้ไขให้ลบ Object ทิ้งทั้งหมดแล้วแล้วสร้างขึ้นมาใหม่ระบุ Range ให้กับ Object เช่นเดิม เมื่อสร้างใหม่จะต้องได้ชื่อทีต่างกัน สังเกตโดยการกดแป้น Ctrl+Click ที่ Object นั้นๆ แล้วสังเกตที่ Name Box (ช่องซ้ายสุดของ Formula Bar)

หลังจากสร้าง Object แต่ละชีตครบตามต้องการแล้วให้ Assign Macro ให้กับ Object แต่ละอันไปยัง Sub ที่ชื่อ GotoCell ตามด้านล่าง ครับ

Code: Select all

Sub GotoCell()
    Dim obj As String
    On Error Resume Next
    obj = Application.Caller
    If InStr(obj, "Rounded") Then
        Range(ActiveSheet.Shapes(obj).DrawingObject.Caption).Select
    End If
End Sub

[March201711]

ทำตามที่อาจารย์แนะนำแล้วค่ะ แต่sheet แต่ละ sheet แต่ละเดือนไม่ไปตาม cell ในแต่ละ object เลยค่ะ

[snasui]

เขียนคำว่า Rounded ให้ตรงตามตัวอักษรที่ผมแจ้งไป ตัวใหญ่ตัวเล็กถือว่ามีความแตกต่างกันครับ

[March201711]

ทำได้แล้วค่ะ ไม่คิดว่า คำแต่ละมีความเฉพาะของcode มากค่ะ ขอบคุณมากค่ะอาจารย์