|
▼かなたん さん:
Application.EnableEvents = False を頭に
Application.EnableEvents = Trueを終わりに入れてください
上手くいきますた。
Sub 切る()
'Application.ScreenUpdating = False
Application.EnableEvents = False
Dim T As Byte, i(3) As Byte
Dim Memo(1 To 52), Mark(3) As String, JQ(11 To 12) As String
Mark(0) = "ダイヤ"
Mark(1) = "ハート"
Mark(2) = "スペード"
Mark(3) = "クラブ"
JQ(11) = "J"
JQ(12) = "Q"
Dim R As Byte, C As Byte
Randomize
i(0) = Int(52 * Rnd) + 1
i(1) = Int(i(0) / 13)
i(2) = i(0) Mod 13
If i(2) = 0 Then
Memo(1) = Mark(i(1) - 1) & "のK"
Worksheets(1).Cells(2, 2) = Mark(i(1) - 1) & "のK"
Worksheets(1).Cells(3, 2) = "K"
ElseIf i(2) >= 11 Then
Memo(1) = Mark(i(1)) & "の" & JQ(i(2))
Worksheets(1).Cells(2, 2) = Mark(i(1)) & "の" & JQ(i(2))
Worksheets(1).Cells(3, 2) = JQ(i(2))
Else
Memo(1) = Mark(i(1)) & "の" & i(2)
Worksheets(1).Cells(2, 2) = Mark(i(1)) & "の" & i(2)
Worksheets(1).Cells(3, 2) = i(2)
End If
Worksheets(1).Shapes(Memo(1)).Top = 67.5
Worksheets(1).Shapes(Memo(1)).Left = 45
For T = 2 To 52
Again:
i(0) = Int(52 * Rnd) + 1
i(1) = Int(i(0) / 13)
i(2) = i(0) Mod 13
If i(2) = 0 Then
Memo(T) = Mark(i(1) - 1) & "のK"
ElseIf i(2) >= 11 Then
Memo(T) = Mark(i(1)) & "の" & JQ(i(2))
Else
Memo(T) = Mark(i(1)) & "の" & i(2)
End If
For i(0) = 1 To (T - 1)
If Memo(T) = Memo(i(0)) Then
GoTo Again
End If
Next
If (T Mod 13 = 0) Then
R = 2 * Int(T / 13)
C = 50
Else
R = 2 * Int(T / 13) + 2
C = (4 * (T Mod 13) - 3) + 1
End If
If i(2) = 0 Then
Worksheets(1).Cells(R, C) = Mark(i(1) - 1) & "のK"
Worksheets(1).Cells((R + 1), C) = "K"
ElseIf i(2) >= 11 Then
Worksheets(1).Cells(R, C) = Mark(i(1)) & "の" & JQ(i(2))
Worksheets(1).Cells((R + 1), C) = JQ(i(2))
Else
Worksheets(1).Cells(R, C) = Mark(i(1)) & "の" & i(2)
Worksheets(1).Cells((R + 1), C) = i(2)
End If
Worksheets(1).Shapes(Memo(T)).Top = 67.5 * (R / 2)
Worksheets(1).Shapes(Memo(T)).Left = 45 * (Int((C - 2) / 4) + 1)
Next
Application.EnableEvents = True
' Application.ScreenUpdating = True
End Sub
|
|