Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


15143 / 76734 ←次へ | 前へ→

【67074】Re:Application.ScreenUpdatingについての質問です。
回答  SK63  - 10/10/30(土) 12:50 -

引用なし
パスワード
   ▼かなたん さん:
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

3 hits

【67065】Application.ScreenUpdatingについての質問です。 かなたん 10/10/30(土) 2:21 質問
【67069】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 12:11 発言
【67072】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 12:28 回答
【67070】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 12:19 発言
【67071】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 12:23 発言
【67073】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 12:33 回答
【67074】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 12:50 回答
【67075】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 13:12 お礼
【67076】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 16:34 発言

15143 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free