ปุ่มเดียว สลับแมโคร

[yangkodza]

Code: Select all

Sub check1()
    Range("E8:X57,AB8:AC57,AJ8:AK57,AG8:AG57").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(E8))=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
        Range("E8").Select
End Sub

Code: Select all

Sub check2()
    Range("E8:X57,AB8:AC57,AJ8:AK57,AG8:AG57").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(E8))=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
        Range("E8").Select
End Sub

Code: Select all

Sub checkAll()
Check.check1 = Not Check.check2
End Sub

ตอนนี้ Check1 และ Check2 ทำงานถูกต้องตามที่ต้องการแล้ว
แต่ต้องการรวมมิตรให้ใช้ปุ่มเดียวกันแต่สลับการทำงานครับ

แมโคร.xlsm

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub checkAll()
    With ActiveSheet.Shapes("สี่เหลี่ยมผืนผ้ามุมมน 7").TextFrame2.TextRange.Characters
        If .Text = "ตรวจสอบ" Then
            Check.check1
            .Text = "ยกเลิก"
        Else
            Check.check2
            .Text = "ตรวจสอบ"
        End If
    End With
End Sub

[yangkodza]

ตัวอย่าง Code ครับ

Code: Select all

Sub checkAll()
    With ActiveSheet.Shapes("สี่เหลี่ยมผืนผ้ามุมมน 7").TextFrame2.TextRange.Characters
        If .Text = "ตรวจสอบ" Then
            Check.check1
            .Text = "ยกเลิก"
        Else
            Check.check2
            .Text = "ตรวจสอบ"
        End If
    End With
End Sub

ใช้งานได้ดีทีเดียวครับ
ขอบคุณมากครับ