ข้อสอบแบบปรนัย แบบเลือกตอบ

[WRKU]

โปรแกรมนี้ อยากจะเขียนต่อยอดจากบทความ การควบคุม Option Button ที่สร้างขึ้นเองด้วย VBA wordpress/custom-option-button/

จากบทความเราเปลื่ยนทิศทางจากแนวตั้งให้เป็นแนวนอน ก็จะเป็นข้อสอบปรนัยแบบเลือกตอบ ก. ข. ค. ง.

1 ข้อ จะต้องเขียน Sub Function 4 ชุด
10 ข้อ จะต้องเขียน Sub Function 40 ชุด

เลย อยากเขียน Sub Function เดียวใช้ได้ทุกข้อ(ทุก Shape) แต่ติดอยู่ที่ว่า เมื่อเราเอา mouse คลิก รูปภาพ แบบ Shape แล้วอยากได้ Name ของ Shape นั้นเพื่อส่งค่าผ่านตัวแปร เพื่อจะนำไปเช็คเงื่อนไขต่อไป

สรุปคำถามแบบ เหมารวมคือ ช่วยแนะนำ วิธีเขียน Code vba ให้มันสั้นกว่านี้หน่อยครับ

[ZEROV]

Shape ทุกตัวสามารถกำหนดมาโครเดียวกันแต่จะทำงานไม่เหมือนกันได้
ค้นคำ
onaction property,application.caller

ตัวอย่าง Code

Code: Select all

Sub Action1()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
.Width = .Height
.OnAction = "Action2"
[a1] = TypeName(shp) & " " & shp.Name
End With
End Sub
Sub Action2()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
.Width = .Height * 2
.OnAction = "Action1"
[a1] = TypeName(shp) & " " & shp.Name
End With
End Sub

[WRKU]

ขอบคุณ มากๆ ครับ

[snasui]

สำหรับการทำงานลักษณะนี้เราจะใช้ Option Button มาช่วย แต่หากต้องการสร้าง Obj ขึ้นเองก็ย่อมได้แต่จะยุ่งยาก

ใน Link ที่ผมเขียนไว้นั้นเป็นตัวอย่างหนึ่งที่เป็นการจัด Group ของ Object ด้วย Code ทำขึ้นอย่างง่าย ๆ

กรณีมี Object เป็นจำนวนมาก สามารถใช้ Code ตามด้านล่างเข้าไปจัดการได้ โดย Assign Macro ให้กับ Oval ทุกตัวครับ

Code: Select all

Sub test0()
    Dim obj As Object, objOther As Object
    Dim objRow As Integer, point As Integer
    Set obj = ActiveSheet.Shapes(Application.Caller)
    objRow = obj.TopLeftCell.Row
    '1 is column d and 4 is column g
    point = obj.TopLeftCell.Column - 3
    For Each objOther In ActiveSheet.Shapes
        If objOther.TopLeftCell.Row = objRow Then
            If objOther.Name = obj.Name Then
                objOther.Fill.ForeColor.RGB = rgbRed
                ActiveSheet.Cells(objRow, "h").Value = point
            Else
                objOther.Fill.ForeColor.RGB = rgbWhite
            End If
        End If
    Next objOther
End Sub

[WRKU]

codeที่เขียน มาเป็นอาทิตย์ เหลือแค่นี้เอง

code ของ อาจารย์
ใช้งานง่าย สะดวกกว่าเดิม แค่ Assign Macro ให้กับ Oval ทุกตัว ก็ทำงานตรงเงื่อนไขแล้ว
แล้วยังไม่ต้องเสียเวลาตั้งชื่อ shape อีก ประหยัดเวลามากครับ