Page 1 of 1

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

Posted: Tue Oct 17, 2017 10:16 am
by 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 ทำงานถูกต้องตามที่ต้องการแล้ว
แต่ต้องการรวมมิตรให้ใช้ปุ่มเดียวกันแต่สลับการทำงานครับ :flw:

แมโคร.xlsm

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

Posted: Tue Oct 17, 2017 10:09 pm
by 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

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

Posted: Wed Oct 18, 2017 3:10 pm
by yangkodza
snasui wrote:ตัวอย่าง 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
ใช้งานได้ดีทีเดียวครับ
ขอบคุณมากครับ :thup: