Excelでオートシェイプのマクロを実行するとステップが飛ぶ理由

このQ&Aのポイント
  • エクセルで簡単なオートシェイプのマクロをつくりました。マクロの実行とステップごとの実行の結果が異なってしまいます。実行すると途中のステップが飛んでしまうようです。なぜでしょうか。
  • マクロを実行すると途中のステップが飛んでしまう
  • Excel VBAのマクロでオートシェイプの寸法線を入れると、途中のステップが飛ばされる
回答を見る
  • ベストアンサー

エクセルで簡単なオートシェイプのマクロをつくりました マクロの実行とステップごとの実行の結果がちがってしまいます

オートシェイプを使った簡単な寸法線の入った図をマクロで書きました。 ステップごとだと期待どおりのアウトプットなのですが、ダイレクトにマクロを実行すると途中のステップがとんでしまうようです。 どうしてでしょうか。 教えてください。 1 Sub 寸法線1() 2 Dim l1, l2, l3, l4, lb, la1, la2, fig1, fig2, fig3, fig4 As Shape 3 x1 = 200 4 y1 = 500 5 x2 = x1 + 100 6 k = Cells(7, 5).Value / Cells(7, 4).Value 7 y2 = y1 - 100 * k 8 Set l1 = ActiveSheet.Shapes.AddLine(x1, y1, x2 + 20, y1) 9 Set l2 = ActiveSheet.Shapes.AddLine(x1, y1, x1, y2 - 15) 10 Set lb = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2) lb.Line.Weight = 2# 11 Set l3 = ActiveSheet.Shapes.AddLine(x2 + 5, y2, x2 + 20, y2) 12 Set l4 = ActiveSheet.Shapes.AddLine(x2, y2 - 5, x2, y2 - 15) 13 Set la1 = ActiveSheet.Shapes.AddLine(x2 + 12.5, y1 - 2, x2 + 12.5, y2 + 2) 14 la1.Line.BeginArrowheadStyle = msoArrowheadTriangle 15 la1.Line.BeginArrowheadLength = msoArrowheadLengthMedium 16 la1.Line.BeginArrowheadWidth = msoArrowheadWidthMedium 17 la1.Line.EndArrowheadStyle = msoArrowheadTriangle 18 la1.Line.EndArrowheadLength = msoArrowheadLengthMedium 19 la1.Line.EndArrowheadWidth = msoArrowheadWidthMedium 20 Set la2 = ActiveSheet.Shapes.AddLine(x1 + 2, y2 - 10, x2 - 2, y2 - 10) 21 la2.Line.BeginArrowheadStyle = msoArrowheadTriangle 22 la2.Line.BeginArrowheadLength = msoArrowheadLengthMedium 23 la2.Line.BeginArrowheadWidth = msoArrowheadWidthMedium 24 la2.Line.EndArrowheadStyle = msoArrowheadTriangle 25 la2.Line.EndArrowheadLength = msoArrowheadLengthMedium 26 la2.Line.EndArrowheadWidth = msoArrowheadWidthMedium 27 Set fig1 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x1 - 10, y1 + 5, 17, 17) 28 fig1.Select 29 Selection.Characters.Text = Str(Cells(6, 3)) 30 Selection.Characters.Font.Bold = True 31 Selection.ShapeRange.Line.Visible = msoFalse 32 Set fig2 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x2 + 5, y2 - 20, 18, 18) 33 fig2.Select 34 Selection.Characters.Text = Str(Cells(7, 3)) 35 Selection.Characters.Font.Bold = True 36 Selection.ShapeRange.Line.Visible = msoFalse 37 Set fig3 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x1 + (x2 - x1) * 0.5 - 13, y2 - 32, 45, 17) 38 fig3.Select 39 Selection.Characters.Text = Str(Cells(7, 4)) 40 Selection.ShapeRange.Line.Visible = msoFalse 41 Set fig4 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationUpward, _ x2 + 15, y1 - 0.5 * (y1 - y2) - 8, 17, 45) 42 fig4.Select 43 Selection.Characters.Text = Str(Cells(7, 5)) 44 Selection.ShapeRange.Line.Visible = msoFalse 45 MsgBox "pause" 46 Call l1.Select 47 Call l2.Select(False) 48 Call l3.Select(False) 49 Call l4.Select(False) 50 Call lb.Select(False) 51 Call la1.Select(False) 52 Call la2.Select(False) 53 Call fig1.Select(False) 54 Call fig2.Select(False) 55 Call fig3.Select(False) 56 Call fig4.Select(False) 57 MsgBox "hit any" 58 Selection.ShapeRange.Group.Delete 59 End Sub Cells(7, 5)=50 cells(7,4)=100 cells(6,3)=1 cells(7,3)=2 です。 左端に行番号をふってあります。 36から44まで飛んでしまいます。 節点 座標 X Y 1 0 0 2 100 50

質問者が選んだベストアンサー

  • ベストアンサー
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

処理が飛ばされているわけではないようですよ シェイプの更新がなされていないだけのようです 44行のMsgBoxの直前に DoEvents を追加してみましょう これで テキストボックスも表示されると思います VBEから実行した場合と シェイプのイベントやツール>マクロから実行した場合で画面の更新のタイミングが違うために起きている現象のようです

pinonokio
質問者

お礼

ありがとうございます でました図が! 一人だけではとうてい到達できないものでした。 何とかVBEができるようになりたい またてほどきお願いします 

関連するQ&A

  • Excel マクロ 任意のセルから実行したい

    こんにちは、Excel2003を使用しています。 ExcelでK55からE55までのセルの値を削除して(空白にして) それぞれに「---を引いた透明のダイアローグボックス」を コピーしていくマクロを作成したことがあります。 このときは開始するセルがK55と決まっていたのですが 今度は任意のセルから(たとえば選択したセルの右隣とか) 実行したいのですがどのようにマクロを作ればよいでしょうか ご存じの方お教えください。 なお参考に上記のマクロを記載します。 Range("E55:J55").Select Selection.ClearContents Range("H55").Select ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 672#, 729#, _ 81#, 13.5).Select Selection.Characters.Text = "" With Selection.Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.Fill.Solid 'Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse ActiveSheet.Shapes("Text Box 12").Select Selection.Characters.Text = "---" With Selection.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.HorizontalAlignment = xlCenter Range("K55").Select ActiveSheet.Shapes("Text Box 12").Select Selection.Copy Range("I55").Select ActiveSheet.Paste Range("H55").Select ActiveSheet.Paste Range("G55").Select ActiveSheet.Paste Range("F55").Select ActiveSheet.Paste Range("E55").Select ActiveSheet.Paste Range("E56").Select Selection.Copy Range("F56:J56").Select ActiveSheet.Paste Application.CutCopyMode = False Range("E56:J56").Select Selection.Copy Range("E57:E59").Select ActiveSheet.Paste Application.CutCopyMode = False Range("K59").Select End Sub

  • エクセルの図形(線)の情報

    シート内に作図されている線の情報を調べるにはどうすればいいのでしょうか? 下記のX1~Y2の値が知りたいのですが。 ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Select あくまでも既に存在している線が対象です。 よろしくお願いします。

  • Excel マクロのエラーを直したいです。

    いつもお世話になっております。 さて、下記マクロを作成(コピー&ペースト)したのですが、矢印以外のあみかけ、罫線などがセルに表示されてしまいます。 どのように修正すれば、矢印だけが表示されるようになるのでしょうか? 修正頂ければ、幸甚です。宜しくお願い致します。 ※マクロ初心者です。 (1)Sub 外部デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF, TP, LF + WD, TP).Select Selection.ShapeRange.Line.Weight = 1# Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub (2)Sub 認知デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF + 6, TP, LF + WD, TP).Select Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOval Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub

  • マクロが実行しない

     二行三列を一枡として月の勤務割表を作成しています。マクロで同じ事を しているのにMacro1の方が実行しません。お教え願えませんでしょうか。 (尚、図形を枠線上にコピペしています。) Sub Macro1()実行しません。 Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 10 To 103 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste End Select Next Next End Sub Sub Macro2()実行します。 ActiveSheet.Shapes.Range(Array("四角形1")).Select Selection.Copy Range("J11:K11").Select ActiveSheet.Paste End Sub

  • エクセルで線の太さと色を変えるマクロ

    マクロ初心者です。ご教示願います。 エクセルのマクロで選択した任意のセルに●→を引くマクロを組みましたが、 線の太さと、色を変えるコードをどこにどう入れたらいのか教えてください。 Sub 線を引く() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddShape(msoShapeOval, LF, TP - 3, 6, 6).Select ActiveSheet.Shapes.AddLine(LF + 6, TP, LF + WD, TP).Select

  • エクセル。マクロの記録で出来たVBAを書き直したい。

    エクセル2000(OSはWindows2000)でマクロの記録を行いました。 四角形を出してA1セルにリンクさせフォント等の設定をしたものです。 Sub Macro5() ActiveSheet.Shapes.AddShape(msoShapeRectangle, 200#, 100#, 140#, 80#). _ Select ExecuteExcel4Macro "FORMULA(""=R1C1"")" With Selection.Font .Name = "Century Gothic" .FontStyle = "太字" .Size = 72 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.ShapeRange.Fill.Visible = msoFalse Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse End Sub これを、実際には四角形をセレクトしないで実行させたいのです。 With ActiveSheet.Shapes.AddShape~ End With といった形になるのでしょうが、どうもうまく出来ません。 ご教示いただければ幸いです。

  • Excelの罫線に関するマクロ

    Excelの罫線に関するマクロ 罫線を引き、それを赤くするマクロを作ったのですが、赤罫線の下にもうひとつ罫線が表示されてしまいます。どこを削除すればよいのでしょうか。 ご教示お願いいたします。 Sub 罫線() Dim T1 As Single, L1 As Single Dim T2 As Single, L2 As Single Dim myShp As Shape With Range("c15") T1 = .Top L1 = .Left End With With Range("d14") T2 = .Offset(1, 1).Top L2 = .Offset(1, 1).Left End With Set myShp = ActiveSheet.Shapes.AddLine(L1, T1, L2, T2) ActiveSheet.Shapes.AddLine(L1, T1, L2, T2).Select With Selection.ShapeRange.Line .Visible = msoTrue .Style = msoLineSolid .Weight = 5# .ForeColor.SchemeColor = 10 End With End Sub よろしくお願いします。

  • エクセルのマクロについて

    エクセル2010を使用しています。 工程表を作成するため、以下のマクロを組もうと苦戦しています。 任意のセルを選択し、マクロを実行すると選択したセルに線を引き 線の上部にテキストボックスで文字を入力できるようにするマクロを 作成しようとしています。 また、テキストボックスは文字入力後、大きさの自動調整をかけようと しています。 線を引くところまでは、うまくいったのですがテキストボックスの挿入→入力待機 →入力後、大きさの自動調整(幅)までのマクロがよくわかりません。 可能であれば、任意の選択したセルの中央に配置をしたいです。 お知恵をお貸しください。よろしくお願いします。 koutei() Dim SentakuTop As Single Dim SentakuLeft As Single Dim SentakuWidth As Single Dim SentakuHeight As Single Dim SentakuAddress As String Dim X0, Y0, X1, Y1 As Variant SentakuAddress = Selection.Address(ColumnAbsolute:=False, RowAbsolute:=False) With ActiveSheet.Range(SentakuAddress) SentakuTop = .Top SentakuLeft = .Left SentakuWidth = .Width SentakuHeight = .Height End With X0 = SentakuLeft Y0 = SentakuTop + SentakuHeight / 2 X1 = SentakuLeft + SentakuWidth Y1 = Y0 With ActiveSheet.Shapes.AddLine(X0, Y0, X1, Y1).Line .ForeColor.RGB = RGB(0, 0, 0) .Weight = 1 .BeginArrowheadStyle = msoArrowheadOval .EndArrowheadStyle = msoArrowheadOval End With End Sub

  • エクセル マクロで引いた線の色設定が戻せない

    エクセルで作成した、出席簿にマクロで 土日などに赤線で罫線の間に縦に オートシェィプ直線を引いています。 次に転出者の欄には、横に線をマクロで引いていますが 色が変えられません。 マクロ終了後もオートシェイプの線色は黒でも 、線を引くと赤のままです。 その線を選択して、色を変えないと 変えられない状態です。 マクロ終了前に、色をリセットする事は出来ませんか? 下記の内容がマクロの一部です。 よろしくお願いします。 If yobi = doyo Or yobi = niti Then Cells(3, 2 + n).Activate If yobi = niti Then With Selection.Font .ColorIndex = 3 End With End If ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 42, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '10=赤色 End If If yobi = "" Then ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 14.25, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 8 '8=黒色 End If

  • Excel マクロでチェックボックスに枠線

    エクセルマクロについて教えて下さい。 Excel2003を使用しています。 1つのシートに、フォームツールボックスからチェックボックスを沢山(300個以上)配置しました。 チェックボックスをクリック(オン)するのと同時にチェックボックスに赤い枠線を付けたいのですが、1つのマクロでチェックボックスのオブジェクト名を取得しながら枠線を付けることは出来ませんでしょうか? 以下のマクロを試してみたのですが、Application.Callerの所でエラーになってしまいました。 Sub checkon() ActiveSheet.Shapes(Application.Caller).Select Selection.ShapeRange.Line.Weight = 3# Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 i = ActiveCell.Address(False, False, xlA1) Range(i).Select End Sub 特定のチェックボックスを指定した場合は、問題ないのですが・・。 (例)ActiveSheet.Shapes("Check Box 1").Select どなたか詳しい方、宜しくお願い致します。

専門家に質問してみよう