Excel (VBA)

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

 
(指定なし : Excel 2019)
複数のトグルボタンを列をズラして実行したいです
投稿日時: 22/03/23 10:20:11
投稿者: tec_VBA_tec

ToggleButtonをクリックすると、列の任意行に斜線を引いたり消したりするコードを作りました。
ToggleButtonを31個作って、
ToggleButton1をJ列
ToggleButton2をK列
ToggleButton3をL列 ・・・
と列を1個ずつズラして各トグルボタンで各列に斜線を引けるようにしているのですが、
行列が変わる場合があるため、修正する際に簡単にしたいと考えております。
 
そこで、複数のトグルボタンの動作を1つのコードをまとめることはできますか?
何卒宜しくお願いいたします。
 

Private Sub ToggleButton1_Click()
    Dim r As Long
    r = Range(Cells(12, 1), Cells(100, 9)).Find("合計").Row 
  '合計と書いてある行(Row)を変数rに格納
        
    If ToggleButton1.Value = True Then  'トグルボタンを押した時、空欄セルに
     With Range(Cells(12, 10), Cells(r, 10)).SpecialCells(xlCellTypeBlanks)
    .Borders(xlDiagonalUp).LineStyle = True  '斜線をつける
     End With
    
    Else  'トグルボタンが押されていない時斜線を消す
        Range(Cells(12, 10), Cells(r, 10)).Borders(xlDiagonalUp).LineStyle = xlNone
    End If
End Sub

Private Sub ToggleButton2_Click()
    Dim r As Long
    r = Range(Cells(12, 1), Cells(100, 9)).Find("合計").Row
    
  'トグル2ボタンは、列を左に1個ずらしています(K列)   
    If ToggleButton1.Value = True Then
     With Range(Cells(12, 11), Cells(r, 11)).SpecialCells(xlCellTypeBlanks)
    .Borders(xlDiagonalUp).LineStyle = True
     End With
    
    Else
        Range(Cells(12, 11), Cells(r, 11)).Borders(xlDiagonalUp).LineStyle = xlNone 
        
    End If
End Sub

回答
投稿日時: 22/03/23 11:16:24
投稿者: Suzu

違う部分は
 
Private Sub ToggleButton1_Click()
   :
    Range(Cells(12, 10), Cells(r, 10)).SpecialCells(〜
 Else 'トグルボタンが押されていない時斜線を消す
    Range(Cells(12, 10), Cells(r, 10)).Borders(xlDiagonalUp 〜
 End If
End Sub
 
Private Sub ToggleButton2_Click()
 :
   Range(Cells(12, 11), Cells(r, 11)).SpecialCells(〜
 Else
   Range(Cells(12, 11), Cells(r, 11)).Borders(xlDiagonalUp) 〜
 End If
End Sub
 
 
の、Column なのですよね。
 
であれば、その値を変数として渡し 処理する共通関数を作れば良いでしょう。

回答
投稿日時: 22/03/23 11:52:23
投稿者: Suzu

Ex)

'col : 対象列    bln:ボタンの値
Sub DrawBordersLine(col As Integer, bln As Boolean)
  Dim rng As Range
  Dim r As Long

  Set rng = Range(Cells(12, 1), Cells(100, 9)).Find("合計")

  If Not rng Is Nothing Then
    r = rng.Row
    '合計と書いてある行(Row)を変数rに格納
    Set rng = Nothing

    With Range(Cells(12, col), Cells(r, col))
      If bln = True Then
         'トグルボタンが押されている時 空欄セルに斜線をつける
        .SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalUp).LineStyle = True
      Else
        'トグルボタンが押されていない時 斜線を消す
        .Borders(xlDiagonalUp).LineStyle = xlNone
      End If
    End With
  End If
End Sub

 
このコードは、
ワークシートの配置されたトグルボタンではなく
ユーザーフォーム上に配置されたトグルボタンでしょうから
 
ボタンを押した際のワークシートに必ず「合計」があるなら良いでしょうが
無い場合は、エラーになります。
それを防ぐ為に オブジェクト変数 rng に受けて から判定を行っています。

投稿日時: 22/03/23 13:01:53
投稿者: tec_VBA_tec

さっそくのご回答ありがとうございます!
いただいたコードについて勉強いたします。
少々お時間ください。

回答
投稿日時: 22/03/23 18:59:30
投稿者: mattuwan44

>行列が変わる場合がある
 
具体的にいうとどういうことですか?
 
例えば、シート上に表を作っていると思うのですが、
行数は可変でその時々で変わると思うのですが、
マクロで操作したい列が、
表の左からn番目の列からm列分を操作したいとか、
というときに、nが変わる?mが変わる?それとも両方?
そして、変わったというのは表の中の何をみたらわかるのですか?
そういう説明をエクセル君に伝える文章をプログラム内に書けばいいので、
まずは日本語で説明してみましょう。

投稿日時: 22/03/24 09:20:01
投稿者: tec_VBA_tec

mattuwan44 さんの引用:
>行列が変わる場合がある
 
具体的にいうとどういうことですか?
 
例えば、シート上に表を作っていると思うのですが、
行数は可変でその時々で変わると思うのですが、
マクロで操作したい列が、
表の左からn番目の列からm列分を操作したいとか、
というときに、nが変わる?mが変わる?それとも両方?
そして、変わったというのは表の中の何をみたらわかるのですか?
そういう説明をエクセル君に伝える文章をプログラム内に書けばいいので、
まずは日本語で説明してみましょう。

 
アドバイスいただきありがとうございます!
行列が変わることも想定してコードを書けば良いのですね。
そこまで思い至っておりませんでした。
説明が以下でよいのかわかりませんが、
アドバイスいただければ幸いでございます。
何卒宜しくお願いいたします。
 
ワークシート上に配置されたToggleButton"数字"をクリックした時、
 
Range(Cells(A列の「1」と書かれている行, A列の「No.」と書かれている行の中で「数字」)と書かれている列) 
, (Cells(A列の「合計」と書かれている行, A列の「No.」と書かれている行の中で「数字」)と書かれている列).SpecialCells(xlCellTypeBlanks)
.Borders(xlDiagonalUp).LineStyle = True '斜線をつける
 
       ↓ToggleButton1
       ■   ■←ToggleButton2     ■
  −−−−−−−−−−−−−−−−−−−−−−−−−−
 No.   │ 1 │ 2 │         │ 31 │
  −−−−−−−−−−−−−−−−−−−−−−−−−−
  1    │   │   │         │   │
  2    │   │   │         │   │
  3    │   │   │         │   │
  −−−−−−−−−−−−−−−−−−−−−−−−−−
  合計  │   │   │         │   │

回答
投稿日時: 22/03/24 11:19:36
投稿者: Suzu

用途につい詳しくは判りませんが、
 
『当該列 の トグルボタンを 押す』 のでは、使いづらいです。
 
私なら
クイックアクセスツールバー から このマクロが実行できる様にし
 (クイックアクセスツールバーのユーザー設定において
  すべてのドキュメント にするか、当該ファイルのみにするか は用途に応じて設定ください)
 
セル範囲 を ユーザーに選択させたうえで
【選択したセル範囲】 と、【予め指定した特定セル範囲】 が重複する範囲
を Intersectにて取得し、その範囲に対し罫線を引く方法の方が使いやすいですね。
 
例えば B3:D8 を選択した状態で

Sub sample()
 Application.Intersect(Selection, Range("A1:C5")).Select
End If

を実行すると、B3:C5 が 選択され直します。
 
 
クイックアクセスツールバー に配置する事を考えると
・Selection が Range以外も取りえる
・重複する範囲が無い場合、Intersect は Nothing を返すので
  そのままSelectメソッドを発行するとエラーになる
を考慮するなら
 
Sub sample()
Dim rng As Range

If TypeName(Selection) = "Range" Then
  Set rng = Application.Intersect(Selection, Range("A1:C5"))
  If Not rng Is Nothing Then
    rng.Select
  End If
End If
End Sub

 
くらいまでは必要でしょう。

投稿日時: 22/03/24 12:07:42
投稿者: tec_VBA_tec

Suzu さんの引用:

用途につい詳しくは判りませんが、
『当該列 の トグルボタンを 押す』 のでは、使いづらいです。

 
Snzu様、ありがとうございます。
クイックアクセスツールバーに配置というのは、とても良いですね!
勉強になりますし、別件で使ってみたいと思いました。
 
さて、今回の用途なのですが、
これまでは紙媒体とボールペンでやっていた作業を、
タブレットとタップペンを用いての作業にすることを想定しております。
そのため、休みの日は、ワンタッチで斜線を引きたかったのでした。
(※休みの日の空欄には「斜線を引く」という社内規定があるため)
 
以上、宜しくお願いいたします。

回答
投稿日時: 22/03/24 15:56:48
投稿者: WinArrow
投稿者のウェブサイトに移動

横から失礼します。
 
>休みの日は、ワンタッチで斜線を引きたかった
「休みの日」の数だけトグルボタンを用意する
ということでしょうか?
何らかの条件で「休みの日」が判定でいれば、
トグルボタンは不要ということも考えられます。
また、1回の操作で、全て斜め罫線を引くこともできますよね?
 
そこで、
「休みの日」は、どの様な状態を考えているのですか?
 
 

回答
投稿日時: 22/03/24 16:42:53
投稿者: WinArrow
投稿者のウェブサイトに移動

投稿日時: 22/03/24 09:20:0
の投稿の表を見ると
1行目が日付のように見えます。
この1行目のセルが日付(シリアル値)であれば、
例えば、曜日や祝日(テーブルが必要)で「休みの日」が判断できるのではないかと思います。
1行目のセルで「休みの日」が判定できるならば・・・・・
トグルボタンではなく、
単純に「休みの日」列の空白セルに「斜め罫線」を引くマクロを作成すればよいと思います。
(1回のマクロ実行で済む)

回答
投稿日時: 22/03/24 16:57:39
投稿者: Suzu

行方向に 人 列方向に 日 の シフト表 でしょうか?
出勤日 には、セルに シフトの番号や、勤務時間 が入る感じ。
 
でもそうすると、
列毎(日毎)に、罫線を入れる必要性が有るのでしょうか?
 
選択セル 内 の空白セルに 斜め線 を引く
もう一度押したら、選択セル 全体の 斜め線を解除する
 
で良い気がします。

Option Explicit

'モジュールレベル変数
Private flg As Boolean

Sub Sumple1()
'選択範囲の空白セルに斜め罫線 を引く
'もう一度実行時には 斜め罫線 を消す
If TypeName(Selection) <> "Range" Then Exit Sub
If flg = False Then
  Selection.SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalUp).LineStyle = True
Else
  Selection.Borders(xlDiagonalUp).LineStyle = xlNone
End If
flg = Not flg
End Sub

 
 
 
その日は、全員 一斉に休み と言うことで列毎に選択する様にしているのであれば
現状は、11行目 に 日付 を入れ、12行目 以降を各人のデータとなっていると思います。
これを、11行目 に 日付 はそのまま。 12行目 に編集時に 【休み】である事を示す値を入れる行
     (今回は休みを示すデータを「1」とします。)13行目以降を各人のデータ
 
Option Explicit

'モジュールレベル変数
Private flg As Boolean

Sub Sumple2()
'(選択範囲) かつ (13行目 に 1 の値のある 列)かつ (J14:AN100の範囲)に該当するセルのうち
'  空白セルに斜め罫線 を引く
'もう一度実行時には 斜め罫線 を消す

Dim rngHoliday  As Range  '13行目 の中で、「1」の値のあるセル
Dim rngHolidays As Range  '13行目 の中で、「1」の値のある列
Dim rngTarget   As Range  '車線を引く範囲のセル

Dim findAddress As String '「1」の値の検索開始セルアドレス

'ユーザー選択がセル以外の時 終了
If TypeName(Selection) <> "Range" Then Exit Sub

'13行目から、セルの値「1」のセルを完全一致にて検索
Set rngHoliday = Rows(13).Find(What:=1, LookAt:=xlWhole)

If Not rngHoliday Is Nothing Then
  '検索の結果、対象セルがあった場合
  '検索された最初のセルアドレスを記録
  findAddress = rngHoliday.Address

  Do
    If rngHolidays Is Nothing Then
      '検索ループ最初の時
      'rngHolidays に 検索結果の列を代入
      Set rngHolidays = rngHoliday.EntireColumn
    Else
      '検索ループ2回目以降
      'rngHolidays に それまでの
      ' rngHolidays に合わせて、新たな検索結果の列を代入
      Set rngHolidays = Application.Union(rngHolidays, rngHoliday.EntireColumn)
    End If
    '検索結果以降のセルを検索繰り返す
    Set rngHoliday = Rows(13).FindNext(After:=rngHoliday)

  '検索が、最初の検索対象セルになるまで繰り返す
  Loop While findAddress <> rngHoliday.Address

  '対象セル
  '(選択範囲) かつ (13行目 に 1 の値のある 列)かつ (J14:AN100の範囲)に該当するセル
  '  を代入
  Set rngTarget = Application.Intersect(Selection, Range("J14:AN100"), rngHolidays)

  '対象セルが無い場合 終了
  If rngTarget Is Nothing Then Exit Sub

  If flg = False Then
    'flg = False の時
    '対象セル のうち、空白セル に対し斜め罫線を引く
    rngTarget.SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalUp).LineStyle = True
  Else
    '対象セル の 斜め罫線を消す
    rngTarget.Borders(xlDiagonalUp).LineStyle = xlNone
  End If
  'flg を反転する
  flg = Not flg
End If
End Sub

投稿日時: 22/03/25 09:33:42
投稿者: tec_VBA_tec

WinArrow さんの引用:
投稿日時: 22/03/24 09:20:0
の投稿の表を見ると
1行目が日付のように見えます。
この1行目のセルが日付(シリアル値)であれば、
例えば、曜日や祝日(テーブルが必要)で「休みの日」が判断できるのではないかと思います。
1行目のセルで「休みの日」が判定できるならば・・・・・
トグルボタンではなく、
単純に「休みの日」列の空白セルに「斜め罫線」を引くマクロを作成すればよいと思います。
(1回のマクロ実行で済む)

 
WinArrow様
アドバイスいただきありがとうございます!
残念ながら休みが不定期のため、判定が難しい状況です。
しかしながら、そのような判定でのマクロ実行は、色々と活用できそうです。
引き続き勉強していきたいと思います。

投稿日時: 22/03/25 09:40:08
投稿者: tec_VBA_tec

Suzu さんの引用:
行方向に 人 列方向に 日 の シフト表 でしょうか?
出勤日 には、セルに シフトの番号や、勤務時間 が入る感じ。
 
でもそうすると、
列毎(日毎)に、罫線を入れる必要性が有るのでしょうか?
 
選択セル 内 の空白セルに 斜め線 を引く
もう一度押したら、選択セル 全体の 斜め線を解除する
 
で良い気がします。

 
Suzu様
 
毎度要望に答えていただきありがとうございます!
いただいた内容で、現場に展開してみたいと思います。
VBAをやり始めたばかりでLoopを理解していないので、勉強させていただきます。
 
今後とも何卒宜しくお願いいたします。