Excel VBA質問箱 IV

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

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


16773 / 76732 ←次へ | 前へ→

【65423】For〜文の入れ子につきまして
質問  murasaki  - 10/5/19(水) 23:28 -

引用なし
パスワード
   初心者ですが、お教えいただけないでしょうか。
マクロの勉強しがてら、公開されているマクロを切り貼りして、
目的を達しようとしていましたが、ついに行き詰まってしまいました。

 特定のセルをクリックしてマクロを走らせると、アクティブセルが
特定範囲に入っているか判断したうえで、指定のセル範囲にオートシェイプの
×印(斜線を二つ描)が描かれるマクロを作りたいと考えております。

 特定セルは、行番号s = 5, 18, 31, 44(=5 + 13 * i)で、
列番号t = 3, 8, 13, 18, 23, 28, 33, 38, 43, 48, 53, 58, 63(=3 + 5 * d)
の組み合わせで、計52個あります。
特定セル(計52個)から指定セルまでは等間隔です。

下記(*)のようなマクロを組んでみましたが、
For ループの処理が、先に書かれている行(縦)方向のセルにしか作動しません。
それを
For d = 0 To 12
   t = 3 + 5 * d
    For i = 0 To 3
       s = 5 + 13 *
というふうに書きかえると、今度は列(横)方向のセルにしか作動(×描画)しなくなりました。

 同じ形態で、丸印描かせるマクロ(AddLineではなくAddShape)は、行方向、列方向にも正常に動いています。

 なにがおかしいのか、どうすればCells(s,t)に変数が代入できるかお教えいただけないでしょうか。
どうぞよろしくお願いいたします。

*)

Sub バツ()
 Dim i As Integer, d As Integer, s As Integer, t As Integer
 Dim xa As Double, ya As Double, Endxa As Double, EndYa As Double, xb As Double, yb As Double, Endxb As Double, EndYb As Double
 Dim p As Variant, g As Variant

  For i = 0 To 3
    s = 5 + 13 * i
     For d = 0 To 12
        t = 3 + 5 * d
  
  Set p = Cells(s, t)
  Set g = Intersect(ActiveCell, p)

If Not g Is Nothing Then
  With Cells(s + 4, t)
   xa = .Left
   ya = .Top
  End With

  With Cells(s + 8, t)
   xb = .Left
   yb = .Top
  End With

  With Cells(s + 7, t + 4)
   Endxa = .Left + .Width
   EndYa = .Top + .Height
  End With

 With Cells(s + 3, t + 4)
   Endxb = .Left + .Width
   EndYb = .Top + .Height
 End With

  Dim ShpN(1 To 2) As Variant
   Set Shp1 = ActiveSheet.Shapes.AddLine(xa, ya, Endxa, EndYa)
   Set Shp2 = ActiveSheet.Shapes.AddLine(xb, yb, Endxb, EndYb)
      ShpN(1) = Shp1.Name
      ShpN(2) = Shp2.Name
        ActiveSheet.Shapes.Range(ShpN(1)).Fill.Visible = msoFalse
        ActiveSheet.Shapes.Range(ShpN(2)).Fill.Visible = msoFalse
        ActiveSheet.Shapes.Range(ShpN(1)).ZOrder msoBringToFront
        ActiveSheet.Shapes.Range(ShpN(2)).ZOrder msoBringToFront
        ActiveSheet.Shapes.Range(ShpN(1)).Line.Weight = 0.55
        ActiveSheet.Shapes.Range(ShpN(2)).Line.Weight = 0.55
        ActiveSheet.Shapes.Range(ShpN).Group.Select

   Set g = Nothing
 Else
    Exit For

End If

    Next d
  Next i

End Sub
1 hits

【65423】For〜文の入れ子につきまして murasaki 10/5/19(水) 23:28 質問
【65425】Re:For〜文の入れ子につきまして kanabun 10/5/20(木) 1:56 発言
【65427】Re:For〜文の入れ子につきまして murasaki 10/5/20(木) 10:38 お礼

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