กำหนดค่า RangeName VBA

[parakorn]

สวัสดีอาจารย์ที่เคารพรักและพี่ๆในบอร์ดทุกท่านครับ

จากไฟล์ที่แนบ ต้องการกำหนดค่า Range การปรับขนาดตัวอักษร

ให้ชี้จุดแบบ Relative เมื่อ Copy ไปที่ ป้ายถัดไป ให้ Range ขยับตาม

ต้องทำอย่างไรขอคำชี้แนะด้วยครับ

พลากร(ไอซ์)

AutoA6.xlsm

(46.44 KiB) Downloaded 12 times

[bank9597]

บอกตำแหน่งชีทที่ต้องการทำ และโค๊ดที่เกี่ยวข้องมาด้วยครับ

[parakorn]

บอกตำแหน่งชีทที่ต้องการทำ และโค๊ดที่เกี่ยวข้องมาด้วยครับ

Sheet "PrintA6st1R"

Code: Select all

Sub ขนาด26()
'
' ขนาด26 Macro
'
' Keyboard Shortcut: Ctrl+a
'
   Range("[color=#FF0040]C25:I25[/color]").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 26
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub

Sub ขนาด32()
'
' ขนาด32 Macro
'
' Keyboard Shortcut: Ctrl+s
'
    Range("[color=#FF0040]C25:I25[/color]").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 32
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub


Sub ขนาด48()
'
' ขนาด48 Macro
'
' Keyboard Shortcut: Ctrl+d
'
    Range("[color=#FF0040]C25:I25[/color]").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 48
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub


Sub ขนาดราคา26()
'
' ขนาดราคา26 Macro
'
' Keyboard Shortcut: Ctrl+f
'
    Range("[color=#FF0040]F32:H35[/color]").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 26
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub

Sub ขนาดราคา32()
'
' ขนาดราคา32 Macro
'
' Keyboard Shortcut: Ctrl+g
'
    Range("[color=#FF0040]F32:H35[/color]").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 32
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub


Sub ขนาดราคา48()
'
' ขนาดราคา48 Macro
'
' Keyboard Shortcut: Ctrl+h
'
    Range("[color=#FF0040]F32:H35[/color]").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 48
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub

[snasui]

ช่วยอธิบายมาใหม่อีกรอบอย่างละเอียดครับว่าต้องการจะทำอะไร ต้องการให้ Range Name ใด ขยับอย่างไร Code ที่เขียนมาเองแล้วนั้นติดขัดที่บรรทัดใครับ

[parakorn]

ช่วยอธิบายมาใหม่อีกรอบอย่างละเอียดครับว่าต้องการจะทำอะไร ต้องการให้ Range Name ใด ขยับอย่างไร Code ที่เขียนมาเองแล้วนั้นติดขัดที่บรรทัดใครับ

สืบเนื่องจากไฟล์ที่แนบ ในชีท"PrintA6st1R" ผมได้เขียน vba สำหรับปรับขนาดตัวอักษร 3 ขนาด คือ 26,32,48 โดยในหนึ่ง ป้ายจะมี ปุ่มสำหรับปรับขนาด ทั้งหมด 6 ปุ่ม

เช่นตั้งแต่ B24 ถึง J40 คือป้ายที่ 1(ตาม index ใน cell A25) จะมีปุ่มปรับขนาดตัวอักษรชื่อ 3 ปุ่ม(L25) และปุ่มปรับขนาดตัวอักษรราคา3 ปุ่ม (L31:L38)

โดย Range ของปุ่มปรับขนาดตัวอักษรชื่อ คือ C25:I25 และ Range ของปุ่มปรับขนาดตัวอักษรราคาคือ F32:H35

ซึ่งสิ่งที่ต้องการคือ เมื่อมีการสร้างป้ายที่ 2(B41:J57) ผมอยาก Copy ปุ่มทั้ง 6 ปุ่มจากป้ายแรก มาวางที่ป้ายที่ 2 โดยให้ Range ปุ่มปรับขนาดอักษรชื่อ ปรับอัตโนมัติ จาก L31:L38 เป็น C42:I42

และปุ่มปรับขนาดตัวอักษรราคาจากF32:H35 เป็น F49:H52 ประมาณนี้ครับ

[snasui]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub test()
    Dim cl As Object, r As Range
    Dim x As String, rx As Range
    Set cl = ActiveSheet.Shapes(Application.Caller)
    x = cl.DrawingObject.Caption
    Set r = ActiveSheet.Range(cl.TopLeftCell.Address).End(xlUp)
    Select Case r.Value
        Case "ขนาดตัวอักษรชื่อ"
            Set rx = r.Offset(1, -9).Resize(1, 9)
            With rx.Font
                .Name = "Tahoma"
                .Size = x
            End With
        Case "ขนาดตัวอักษรราคา"
            Set rx = r.Offset(1, -9).Resize(7, 9)
            With rx.Font
                .Name = "Tahoma"
                .Size = x
            End With
    End Select
End Sub

ให้ Assign Macro Test ให้กับทุกปุ่ม จากนั้นทดสอบคลิกปุ่มใด ๆ แล้วสังเกตการเปลี่ยนแปลง

[parakorn]

ขออภัยเนื่องจากติดป่วย+ภาระกิจมากมาย จึงล่าช้าครับผม

สืบเนื่องจากโค้ดที่อาจารย์เขียนให้ ในส่วนของ "ขนาดตัวอักษรชื่อ" สามารถแสดงผลได้อย่างถูกต้อง แต่

"ขนาดตัวอักษรราคา" มีข้อผิดพลาดคือมันปรับขนาดตัวอักษรใน Cell อื่นๆด้วย(Cell ที่ต้องการมีเพียง F32:H35)

แต่ผมขออนุญาติ แนบไฟล์ใหม่ เนื่องจากแบบฟอร์มทำป้าย มีหลายแบบฟอร์ม หลายชีท และยกเลิกการ Merge Cell

ของ "ขนาดตัวอักษรราคา" ตามไฟล์ที่แนบครับ โดยตัวอักษรที่ต้องการปรับขนาดคือ ตัวเลขสีแดง ในแต่ละชีทเท่านั้น

โดยแยกปุ่มสำหรับปรับขนาดเพื่อให้คนพิมพ์ป้ายสะดวกในการใช้งาน ครับผม

AutoA6(Revise1).xlsm

(55.98 KiB) Downloaded 6 times

[snasui]

ลบปุ่มใน L31 > Copy ปุ่มใน L25 มาวางแล้วทดสอบดูใหม่ครับ

[parakorn]

E31 และ I31 มันโดนปรับขนาดไปด้วยครับผม

ต้องการให้มันปรับเฉพาะ H31 ครับ

[snasui]

อันนั้นก็ต้องปรับ Code มาเองก่อน ติดตรงไหนแล้วค่อยถามกันต่อครับ

[parakorn]

ปรับโค้ดให้เป็นไปตามที่ต้องการได้แล้วครับ แต่ยังติดปัญหาการ copy ปุ่มปรับขนาดตัวอักษร เมื่อ copy ไปยังป้ายถัดไป ปุ่มยังไม่ทำงานบนป้ายใหม่

จากไฟล์ที่แนบ Sheet "PrintA6st1R"

ปุ่ม L18 ไม่ทำการปรับขนาด C18:I18 แต่ยังทำงาน C5:I5

และ ปุ่ม L24 ไม่ทำการปรับขนาด H24 แต่ยังทำงาน H11 ต้องแก้ไขอย่างไรครับ

[snasui]

ลองสร้างปุ่มโดยไม่ใช้การ Copy แล้วดูว่ายังเป็นเหมือนเดิมอีกหรือไม่ครับ

[parakorn]

ได้ละครับ ขอบคุณครับ