Snasui Excel Forum

Code: Select all

Option Explicit

Dim obj As Object
Dim objg As Object

Sub SelectObj1(One As Object, Grp As Object)
    With One
        .Fill.ForeColor.SchemeColor = 10
        .Fill.Visible = Not .Fill.Visible
    End With
    Grp.Fill.Visible = msoFalse
    If One.Fill.Visible Then
        Select Case One.Name
            Case "Oval 15"
                Range("C14:C16").ClearContents
                Range("C14") = "IN"
            Case "Oval 16"
                Range("C14:C16").ClearContents
                Range("C15") = "P"
            Case "Oval 17"
                Range("C14:C16").ClearContents
                Range("C16") = "BL"
        End Select
    Else
        Range("C14:C16").ClearContents
    End If
End Sub

Sub ObjInvoice()
    Set obj = ActiveSheet.Shapes("Oval 15")
    Set objg = ActiveSheet.Shapes.Range(Array("Oval 16", "Oval 17"))
    SelectObj1 obj, objg
End Sub

Sub ObjPacking()
    Set obj = ActiveSheet.Shapes("Oval 16")
    Set objg = ActiveSheet.Shapes.Range(Array("Oval 15", "Oval 17"))
    SelectObj1 obj, objg
End Sub

Sub ObjBL()
    Set obj = ActiveSheet.Shapes("Oval 17")
    Set objg = ActiveSheet.Shapes.Range(Array("Oval 15", "Oval 16"))
    SelectObj1 obj, objg
End Sub

Code: Select all

Sub ObjInvoice()
    Set obj = ActiveSheet.Shapes("Oval 15")
    With obj
        .Fill.ForeColor.SchemeColor = 10
        .Fill.Visible = Not .Fill.Visible
        If .Fill.Visible Then
            Range("C14") = "IN"
        Else
            Range("C14") = ""
        End If
    End With
End Sub

Sub ObjPacking()
    Set obj = ActiveSheet.Shapes("Oval 16")
    With obj
        .Fill.ForeColor.SchemeColor = 10
        .Fill.Visible = Not .Fill.Visible
        If .Fill.Visible Then
            Range("C15") = "P"
        Else
           Range("C15") = ""
        End If
    End With
End Sub

Sub ObjBL()
    Set obj = ActiveSheet.Shapes("Oval 17")
    With obj
        .Fill.ForeColor.SchemeColor = 10
        .Fill.Visible = Not .Fill.Visible
        If .Fill.Visible Then
            Range("C16") = "B/L"
        Else
            Range("C16") = ""
        End If
    End With
End Sub