マクロについて質問です。 下記のように対応する背景色の場合、塗りつぶされた色の3つ右のセルの値が削除されるようにしました。

Visual Basic57閲覧xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

0
画像

ThanksImg質問者からのお礼コメント

無事解決いたしました。 お二方とも本当にありがとうございました。

お礼日時:3/1 11:45

その他の回答(1件)

0

ボタンには背景色を付けれません。四角形でボタンもどきを作ります。 まず、ボタンもどきを入れたいシートでMacro1を実行して下さい。 A1~A7にボタンもどきができます。位置、サイズを好きな所へ変更して下さい。 以降、ボタンもどきを押すと処理がされます。 Macro2はボタンもどきの色を判断しています。直接動かすとエラーになります。 Option Explicit ' Sub Macro1()     Dim ColorIndexEs As Variant     Dim Cell As Range     Dim Co As Integer     Dim Shape As Shape '     ColorIndexEs = Array(43, 39, 6, 45, 40, 37, 35) '     For Each Cell In [A1:A7]         Set Shape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _             Cell.Left, Cell.Top, Cell.Width, Cell.Height)         Co = ColorIndexEs(Cell.Row - 1)         Shape.Fill.ForeColor.SchemeColor = Co + 7         Shape.TextFrame2.TextRange.Characters.Text = "色 " & Co & " 削除"         Shape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack         Shape.TextFrame2.VerticalAnchor = msoAnchorMiddle         Shape.OnAction = "Macro2"     Next Cell End Sub ' Sub Macro2()     Dim Co As Integer     Dim Sheet As Worksheet     Dim Cell As Range '     If MsgBox("指定色の3つ右を消去します", vbOKCancel) = vbCancel Then         End     End If     Co = ActiveSheet.Shapes(Application.Caller).Fill.ForeColor.SchemeColor - 7     Application.ScreenUpdating = False '     For Each Sheet In Worksheets '         For Each Cell In Sheet.[D1:AY91].SpecialCells(xlCellTypeConstants) '             If Cell.Offset(, -3).Interior.ColorIndex = Co Then                 Cell.ClearContents             End If     Next Cell, Sheet End Sub ' Sub Macro3()     Dim ColorIndexEs As Variant     Dim Sheet As Worksheet     Dim Cell As Range '     ColorIndexEs = Array(43, 39, 6, 45, 40, 37, 35) '     For Each Sheet In Worksheets '         For Each Cell In Sheet.[C1:C14]             Cell.Interior.ColorIndex = ColorIndexEs(Rnd * 7 - 0.5)             Cell.Offset(, 3) = "AAA"     Next Cell, Sheet End Sub