Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2010)
描画表示がVBA通りに行きません。。
投稿日時: 17/06/13 23:43:25
投稿者: しゅんたろう

下記は、表を参照し、"あり”だったら所定の位置に○を描くものです。
F8(ステップ)で進行させるとちゃんと動作するのですが、
F5(実行)すると、○が描かれません。。理由が分かる方ご回答お願い致します。
 
Sub Macro4()
  
Const m As Integer = 5 '氏名の開始行
Const n As Integer = 12 '氏名のカラム
 
Dim i As Integer
Dim j As Integer
Dim shp As Shape
 
  For Each shp In ActiveSheet.Shapes
    shp.Delete
  Next shp
 
  j = n
  For i = m To 50
   
    Do Until Cells(i, j - 1) > 0
      i = i + 1
    Loop
   
    Cells(i, j).Select
    Selection.Copy
    Range("B4").Select
    Range("B4").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "MS Pゴシック"
        .Size = 24
 
    End With
     
   Range("D5") = Cells(i, j + 1)
   Range("F5") = Cells(i, j + 2)
       
    If Cells(i, j + 3) = "あり" Then
        Macro1
    End If
'
    MsgBox "次の印刷"
     
    For Each shp In ActiveSheet.Shapes
      shp.Delete
    Next shp
 
  Next
     
End Sub
 
Sub Macro1()
    ActiveSheet.Shapes.AddShape(msoShapeOval, 168.75, 135.75, 35.25, 35.25).Select
    With Selection.ShapeRange.Line
      .Visible = msoTrue
      .Weight = 0.5
    End With
    Selection.ShapeRange.Fill.Visible = msoFalse
    With Selection.ShapeRange.Line
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 0, 0)
      .Transparency = 0
    End With
End Sub
 

回答
投稿日時: 17/06/14 00:19:03
投稿者: カリーニン

Macro4の方は、ループの中で最後に↓で全部シェイプを削除してますが。
 
> For Each shp In ActiveSheet.Shapes
> shp.Delete
> Next shp

回答
投稿日時: 17/06/14 00:24:28
投稿者: WinArrow
投稿者のウェブサイトに移動

○の位置が、いつも同じ場所になっているんだけど??
 
> ActiveSheet.Shapes.AddShape(msoShapeOval, 168.75, 135.75, 35.25, 35.25).Select

投稿日時: 17/06/14 14:42:38
投稿者: しゅんたろう

ご回答ありがとうございます。
リスト一行ずつ処理にしてますので
次の行の処理に行く前にクリアしてます。
MsgBox の時点では○が描かれているはずなのに
それができません。
MsgBox のところは実際は印刷処理なのですが、
デバック便宜上MsgBox にしております。
 
疑問としてはF8(ステップ)で進行させるとちゃんと動作するのですが、 F5(実行)すると、○が描かれないのでデバッグにて解消できないので困っております。
分かる方いらっしゃいましたらよろしくお願いいたします。

回答
投稿日時: 17/06/14 14:52:40
投稿者: カリーニン

MsgBoxの前に Exit Subを入れるとどうなりますか?

回答
投稿日時: 17/06/14 16:06:55
投稿者: mattuwan44

なんででしょうね?
 
画面の更新が追い付いてないのかなぁ。。。。
以下だとどうでしょう?
 
Option Explicit
 
Sub メイン()
    Dim rngTop As Range
    Dim rngBottom As Range
    Dim c As Range
    Dim shp As Shape
 
    With ActiveSheet
        Set rngTop = .Range("L5")
        Set rngBottom = .Cells(.Rows.Count, "L").End(xlUp)
        If rngBottom.Row < rngTop.Row Then Exit Sub
 
        With .Range("B4")
            .Value = .Value
            With .Font
                .Name = "MS Pゴシック"
                .Size = 24
            End With
        End With
    End With
 
    For Each c In Application.Range(rngTop, rngBottom)
        With ActiveSheet
            .Range("D5").Value = c.Offset(, 1).Value
            .Range("F5").Value = c.Offset(, 2).Value
            If c.Offset(, 3).Value = "あり" Then Set shp = Macro1()
        End With
                 
        MsgBox "?"
         
        On Error Resume Next
        shp.Delete
        On Error GoTo 0
    Next
End Sub
 
Function Macro1() As Shape
    Dim shp As Shape
 
    Application.ScreenUpdating = False
    Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, 168.75, 135.75, 35.25, 35.25)
    With shp.Line
        .Visible = msoTrue
        .Weight = 0.5
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
    End With
    shp.Fill.Visible = msoFalse
    Set Macro1 = shp
    Application.ScreenUpdating = True
End Function

回答
投稿日時: 17/06/14 21:30:52
投稿者: MMYS

つぎのようにした場合、どうなりますか。
  
    ActiveSheet.PrintPreview
    MsgBox "次の印刷"
  
または、この場合はどうですか。
  
    Range("A1").Select
    DoEvents
    MsgBox "次の印刷"
  
  
Excelに限らず画面の描写はWindowsが担当します。
VBAが動作中はCPUを占有してますから、OSに制御が渡らない限り
(通常はVBAが終了するまで)画面描写されません。
ステップ実行中はCPUが逐次開放されますからステップごとに画面描写されます。

投稿日時: 17/06/14 23:20:35
投稿者: しゅんたろう

みなさまご協力とご回答誠に有難うございました。
 
mattuwan44様
プロのコーディング非常に参考になります。
描写されました。
 
MMYS様
両方いけました!
なるほど、そういうことでしたか。
 
非常に勉強になりました。
 
皆さま有難うございました。