初めて質問させていただきます。
VBAは初心者です。
データの有無で下の余白に自動で斜線を引きたいと思っています。
ネットで色々調べて個別に斜線を作成・削除のマクロ(*)はなんとか作ってはみたのですが、
自動で斜線作成・削除には至っていません。
SheetChangeイベントを利用するとは思うのですが、
そこから先どうすればいいのか全くわかりません。
お手上げです。
どなたかご教授いただけないでしょうか?
Excel2016を使用しています。
何卒宜しくお願い致します。
↓乱文ですみません。
シート1ページ目と以降の他のシートは全く同じ内容で、
1ページ目に入力をすると他のページにも反映されるように式を入れています。
シート1ページ目のQ34:U34(①)、V34:Z34(②)、AA34:AE34(③)は結合セルで、
入力規制でデータをそれぞれ選べるようになっています。
①、②、③にデータがない(入力規制で選ばずブランク)場合、
①はその下のQ35:U66、②はV35:Z66、③はAA35:AE66に
添付画像のように右下がりの斜線を引いて、これを他のすべてのシートの同じ位置にも斜線を引きたいです。(①、②、③は③だけデータがなかったり、②・③だけデータがなかったりします。)
*以下はQ35:U34で斜線を入れた時と削除したときのマクロを
わからないなりに調べて作ってみました。。。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線作成①()
Dim i As Long
For i = 2 To Worksheets.Count
Worksheets(1).Shapes.AddLine(Range("Q35").Left, Range("Q35").Top, Range("V67").Left, Range("V67").Top).Select
Selection.Copy
Sheets(i).Select
Range("Q35:U36").Select
Sheets(i).Paste
Next
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線削除①()
Dim j As Long
Dim r As Range
Dim o As Object
For j = 1 To Worksheets.Count
For Each o In Worksheets(i).DrawingObjects
Sheets(j).Select
Range("Q35:U66").Select
Set r = Range("Q35:U36")
If Not Intersect(o.TopLeftCell, Worksheets(j).Range("Q35:U36")) Is Nothing Then
o.Delete
End If
Next
Next
End Sub
No.3ベストアンサー
- 回答日時:
No.1 No.2 の補足
今まで既にひかれている斜線は削除しませんので事前に斜線は削除しておいてください。
なぜかと言うとシェイプにシート名などを含んだ名前を付けてそれを使っているので、既に引かれている物は名前がマッチしないので削除できません。
No.2
- 回答日時:
No.1 の修正です。
「斜線作成」の中で「斜線削除」を呼び出すようにしました。Sub 斜線作成(シート名 As String, 左上行番号 As Long, 左上列番号 As Long, 右下行番号 As Long, 右下列番号 As Long)
Dim 左 As Long
Dim 上 As Long
Dim 右 As Long
Dim 下 As Long
Dim シェイプ As Object
Dim シェイプ名 As String
Dim 有 As Boolean
Call 斜線削除(シート名, 左上行番号, 左上列番号, 右下行番号, 右下列番号)
左 = Sheets(シート名).Columns(左上列番号).Left
上 = Sheets(シート名).Rows(左上行番号).Top
右 = Sheets(シート名).Columns(右下列番号 + 1).Left
下 = Sheets(シート名).Rows(右下行番号 + 1).Top
シェイプ名 = シート名 & ":" & 左上行番号 & ":" & 左上列番号 & ":" & 右下行番号 & ":" & 右下列番号
Sheets(シート名).Shapes.AddLine(左, 上, 右, 下).Name = シェイプ名
End Sub
No.1
- 回答日時:
以下のようなものはいかがですか?
「斜線作成」と「斜線削除」は汎用性の高い物を作りました。
変数を日本語にしたので大体わかると思いますが判らないときは聞いて下さい。
「斜線作成」では同じ名前のシェイプが存在した時はそれを削除してから新たに作っています。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub Sample()
Dim シート As Worksheet
Dim 列番号 As Long
For Each シート In Worksheets
For 列番号 = 17 To 27 Step 5
If シート.Cells(34, 列番号).Value = "" Then
Call 斜線作成(シート.Name, 35, 列番号, 66, 列番号 + 4)
Else
Call 斜線削除(シート.Name, 35, 列番号, 66, 列番号 + 4)
End If
Next
Next
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線作成(シート名 As String, 左上行番号 As Long, 左上列番号 As Long, 右下行番号 As Long, 右下列番号 As Long)
Dim 左 As Long
Dim 上 As Long
Dim 右 As Long
Dim 下 As Long
Dim シェイプ As Object
Dim シェイプ名 As String
Dim 有 As Boolean
左 = Sheets(シート名).Columns(左上列番号).Left
上 = Sheets(シート名).Rows(左上行番号).Top
右 = Sheets(シート名).Columns(右下列番号 + 1).Left
下 = Sheets(シート名).Rows(右下行番号 + 1).Top
シェイプ名 = シート名 & ":" & 左上行番号 & ":" & 左上列番号 & ":" & 右下行番号 & ":" & 右下列番号
For Each シェイプ In Sheets(シート名).DrawingObjects
If シェイプ.Name = シェイプ名 Then
シェイプ.Delete
End If
Next
Sheets(シート名).Shapes.AddLine(左, 上, 右, 下).Name = シェイプ名
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線削除(シート名 As String, 左上行番号 As Long, 左上列番号 As Long, 右下行番号 As Long, 右下列番号 As Long)
Dim シェイプ As Object
Dim シェイプ名 As String
シェイプ名 = シート名 & ":" & 左上行番号 & ":" & 左上列番号 & ":" & 右下行番号 & ":" & 右下列番号
For Each シェイプ In Sheets(シート名).DrawingObjects
If シェイプ.Name = シェイプ名 Then
シェイプ.Delete
End If
Next
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) VBAが止まります。 1 2022/09/02 14:51
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ExcelのVlookup関数の制限について
-
エクセルの列の限界は255列以上...
-
SUMPRODUCTにて別シートのデー...
-
エクセルの保護で、列の表示や...
-
Excelでの並べ替えを全シートま...
-
Excel の複数シートの列幅を同...
-
エクセルVBAで、ある文字を含ん...
-
エクセルのブック分割マクロを...
-
エクセルで、チェックボックス...
-
エクセルの複数シートにあるデ...
-
excel 複数のシートの同じ場所...
-
Excel 計算式を教えて下さい
-
【VBA】複数のシートの指定した...
-
VBAで繰り返しコピーしながら下...
-
オートフィルタ使用時にCOUNTIF...
-
エクセルで横並びの複数データ...
-
別シートに成約をボタン1つで転...
-
【エクセル】1列のデータを交...
-
Excelで条件別にシートを振り分...
-
エクセルで、book全体の検索&...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelのVlookup関数の制限について
-
文字の色も参照 VLOOKUP
-
オートフィルタ使用時にCOUNTIF...
-
エクセルの保護で、列の表示や...
-
VBAで繰り返しコピーしながら下...
-
エクセル関数に詳しい方、教え...
-
【条件付き書式】countifsで複...
-
Excel の複数シートの列幅を同...
-
エクセル マクロ 標準モジュー...
-
エクセルで横並びの複数データ...
-
エクセルの列の限界は255列以上...
-
Excelでの並べ替えを全シートま...
-
VLOOKアップ関数の結果の...
-
SUMPRODUCTにて別シートのデー...
-
エクセルで、チェックボックス...
-
Excel VBA ピボットテーブルに...
-
【エクセル】1列のデータを交...
-
エクセルVBAで、ある文字を含ん...
-
エクセルのブック分割マクロを...
-
excel 複数のシートの同じ場所...
おすすめ情報