Excelで三角くじを作ってみよう

Sub ExPasteShape(lno As Long, xx As Long, yy As Long, rr As Long)
    Dim tshape As Shape
    
    '貼り付け
    ActiveSheet.PasteSpecial Format:="図 (GIF)", Link:=False, DisplayAsIcon:=False
    Set tshape = Selection.ShapeRange(1)
    '位置変更
    tshape.Left = xx
    tshape.Top = yy
    '名前を付ける
    tshape.Name = "kuji" & lno
    '回転
    tshape.IncrementRotation rr
    'マクロの割り当て
    tshape.OnAction = "ExShapeClick"
    
    Set tshape = Nothing
End Sub


'くじを配置する
Private Sub ExKujiSet(maisu As Long)
    Dim i As Long
    Dim xmax As Long
    Dim ymax As Long
    Dim xx As Long
    Dim yy As Long
    Dim rr As Long
    
    '配置する範囲を取得
    xmax = Sheets("くじ引き").Range("A1:K20").Width
    ymax = Sheets("くじ引き").Range("A1:K20").Height
        
    '乱数の生成
    Randomize
    Sheets("くじ引き").Activate
    For i = 1 To maisu
        xx = Int((Rnd * xmax) + 1)
        yy = Int((Rnd * ymax) + 1)
        rr = Int((Rnd * 360) + 1)
        Call ExPasteShape(i, xx, yy, rr)
    Next
End Sub