派遣事務員の迷走

派遣事務員コロ子。会社の犬。顔出しNG。常に迷走している。

同じユーザーフォームを複数同時に表示させる

こんにちは。
派犬事務員のコロ子です。

前回「ユーザーフォームは作った瞬間にインスタンスが生成されてオブジェクトが使えるようになる」の記事を書いたら
「あえてインスタンスを生成することもできるよ」と教えていただいた。
ということは、同じユーザーフォームを複数同時に表示することもできるのか!?
さっそく試してみよう!

同じユーザーフォームを複数同時に表示させる

このユーザーフォームを2つ同時に表示する

Sub Test1()

    Dim uf1 As UserForm1
    Dim uf2 As UserForm1

    Set uf1 = New UserForm1
    Set uf2 = New UserForm1

    uf1.Show vbModeless
    uf1.TextBox1.Value = 100 ’←値の代入はフォーム表示の前でも後でも可

    uf2.Show vbModeless
    uf2.TextBox1.Value = 200
    uf2.Top = uf1.Top + 150 ’←フォームの位置設定はフォーム表示後に行う

End Sub

おお!できた!

【解説】

UserForm1型の変数を宣言してNewでインスタンスを生成する

Sub Test1()

    Dim uf1 As UserForm1
    Dim uf2 As UserForm1
    
    Set uf1 = New UserForm1
    Set uf2 = New UserForm1

ユーザーフォームはモードレス(vbModeless)で開く。
モードレスにしないとuf1を閉じてからでないとuf2が表示されない。

    uf1.Show vbModeless

uf1とuf2が同じ位置に重ならないようにuf2を下にずらす。

    uf.Show vbModeless
    uf.Top = FormTop

フォームの位置はフォームを表示してから設定しないとエラーになる。
TextBoxへの値の代入はフォーム表示の前でも後でも可。

ダブルクリックしたらどんどんフォームが開くのを作る

なんか楽しいのでダブルクリックしたらフォームが開くのを作ってみた。
クリックした数字をTextBox1に入れてどんどんフォームを開く。


シートモジュールに記載するコード

'2番目以降のフォームの位置。パブリック変数を用意する
Public FormTop As Long

'ダブルクリックのイベント
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim uf As UserForm1
    Set uf = New UserForm1
    
    '前に作ったフォームと重ならないようにする
    FormTop = FormTop + 100
    
    uf.TextBox1.Value = Target.Value
    uf.Show vbModeless
    uf.Top = FormTop

End Sub

フォームモジュールに記載するコード

フォームを閉じるごとにフォームの開始位置を戻す

'ユーザーフォームを閉じるとき
Private Sub UserForm_Terminate()

    Sheet1.FormTop = Sheet1.FormTop - 100

End Sub

VBA ユーザーフォームは作った瞬間にオブジェクトが使えるようになる!?(コロ子勘違いしていた)

こんにちは。
派犬事務員のコロ子です。


お久しぶりです。長らくブログを書いてなかったけど、やめたわけじゃないよ~。
最近仕事で変な単調作業をしていて犬小屋に帰ってからぐったり疲れてパソコンを触る元気がなかったので。
VBAを書く仕事は全然疲れないのに単調作業は本当に疲れて困るわぁ~(>_<)


ユーザーフォームについて、またまた勘違いしてました・・・。

何を勘違いしていたかというと、ユーザーフォームって作った瞬間にインスタンスが生成されてオブジェクトが使えるようになるんですね。

どーゆーことかというと、
①「ボタン1」と押すとUserForm1が表示される。
②TextBox1に数字を入力する。
③UserForm1の「OK」ボタンを押すとTextBox2にTextBox1を10倍した数字が入る。
このようなフォームの場合、

この処理のコードは下記のようになる。

「ボタン1」に登録するコード(Sheetモジュールか標準モジュールに記載)
Public Sub ボタン1()
 'ユーザーフォームを表示する
    UserForm1.Show
End Sub
UserForm1のOKボタンを押したときのコード(UserForm1モジュールに記載)
Private Sub CommandButtonOK_Click()
 'TextBox2にTextBox1×10を入力
    TextBox2.Value = TextBox1.Value * 10
End Sub

ねーねー。
「ボタン1」を押してフォームが表示されるのも必要だけど、シートの数字をダブルクリックしたら、最初からその数字がTextBox1に入ってフォームが表示されるようにできる?
さらにTextBox2にも×10の値を入れといてねー。

楽勝!

できますよ~。すぐやりますね~。

簡単だよー、秒でできるよー、と下記のコードを書いたら

シートモジュールのダブルクリックイベント
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    UserForm1.Show
   
    UserForm1.TextBox1.Value = Target.Value
    Call UserForm1.CommandButtonOK_Click
    
End Sub

※【注意】他のモジュールからCallするので
Private Sub CommandButtonOK_Click()

Public Sub CommandButtonOK_Click()
に変更する。

あれー・・・。

UserForm1.TextBox1.Value = Target.Valueに数字が入っていない。
どーゆーことかと、ステップ実行をしてみたら

ダブルクリックのイベントの中でユーザーフォームを開くので、次の処理はユーザーフォームを閉じてからじゃないと実行できないのね。なるほど~!
でも、何か変だなぁ。ユーザーフォームを閉じているのに何でUserForm1.TextBox1.Value = Target.Valueがエラーにならないんだろう・・・?

もう1回ダブルクリックでユーザーフォームを開いてみると、
なんと!!さっきダブルクリックした値が入っているではないですか!

【1回目】
3をダブルクリックしてユーザーフォームを開く

TextBox1に値は入っていない

【2回目】
5をダブルクリックしてユーザーフォームを開く

1回目でダブルクリックした値が入っている。


【3回目】
さらに別の数字をダブルクリックしてユーザーフォームを開いてみると

2回目でダブルクリックした値が入っている。

ど、どういうこと?
何で前回の値を覚えているの?
ユーザーフォームってフォームを表示したときにインスタンスが生成されて、閉じたときに破棄されるんじゃないの???

???と思いながら、下記コードを試したてみた。

Sub Test1()
    UserForm1.TextBox1 = 10
End Sub

UserForm1.TextBox1 に10を入れる

Sub Test2()
    UserForm1.Show
    Debug.Print UserForm1.TextBox1.Value
End Sub

UserForm1が表示される。
TextBox1 に10が入っている。

Sub Test3()
   Debug.Print UserForm1.TextBox1.Value
End Sub

UserForm1を閉じて実行するとTextBox1は空欄。

ユーザーフォームは表示していないときもメンバーにアクセスできる。
ということは
①ユーザーフォームはVBEエディタで作った瞬間にインスタンスが生成されてオブジェクトが参照できる。
②閉じた時に値が破棄される。
ということなのね!

では、正解は

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    'TextBox1に値をセット
    UserForm1.TextBox1.Value = Target.Value
    
    'クリックイベントを呼び出す
    Call UserForm1.CommandButtonOK_Click
    
    'フォームを表示
    UserForm1.Show
    
End Sub

TextBox1に値をセットして
リックイベントを呼び出して
それからフォームを表示を表示する。

またまた、長いこと勘違いしてたわぁ~。全然楽勝じゃなかったわぁ~。
ユーザーフォームは表示された時にインスタンスが生成されると思ってた。
だって「UserForm_Initialize」ってイベントがあるから。。。

ということは、ユーザーフォームのメンバーの初期値は「Initialize」イベントの中で書かなくてもOKってこと?

例えば、下記のようなシートでユーザーフォームを表示するとき
「ボタン1」を押したら、コンボボックスにB列のデータを
「ボタン2」を押したら、コンボボックスにD列のデータを
表示させたいとき


いつも「Initialize」イベントで書いていたけど、これでいいんだよね。

「ボタン1」に登録するコード(Sheetモジュールか標準モジュールに記載)
Public Sub ボタン1()
    UserForm2.ComboBox1.RowSource = Range("B6:B20").Address
    UserForm2.Show
End Sub

「ボタン2」に登録するコード(Sheetモジュールか標準モジュールに記載)
Public Sub ボタン2()
    UserForm2.ComboBox1.RowSource = Range("D6:D20").Address
    UserForm2.Show
End Sub

もしかして「Initialize」イベント不要?
(いやいや、場合によるから)

VBAで①②③、ABCなどの連続番号を入力する(オートフィル風)

こんにちは。
派犬事務員のコロ子です。

休日は一瞬で終わる

①②③やABCのオートフィル風を作る

先日、「①②③とかABCとかをオートフィルできる方法ないんですか?」と質問を受けた。
どうやらないっぽい。関数とかで作れるみたいだけど、毎回関数を入れるのも面倒なのでVBAで作ってみよう。

Asc関数

「Asc関数」の戻り値は 「Shift_JIS文字コード」を利用して作成してみよう。
まずはShift_JIS文字コードを確認してみる。

右下のタスクバーの文字を右クリックしてIMEパッド」を開く

IMEパッドの左側から「シフトJIS」を選択する。

半角英数、記号などフォルダがいっぱいある。半角英数から英文字を探してみると、「ABC・・・Z」は連続した文字コードになっている。①~⑳も連続した文字コードになっている。ということは、ループで作れる!

オートフィル風は
①まず先頭に文字を入力する。
②連続文字を入力する範囲を選択する。
③選択した範囲に連続した文字が入るようにする。

上記のコードを作成する。

Sub 選択範囲を連続番号にする()

    Dim ran As Range
    Dim buf As Long

    For Each ran In Selection

        '先頭のセルの場合
        If ran = Selection(1) Then

            'Acsコードに変換
            buf = Asc(ran.Value)

        Else

            '文字コードに戻す
            buf = buf + 1
            ran = Chr(buf)

        End If

    Next ran

End Sub

コードができたら、どのExcelでも使えるように個人用マクロブックの「PERSONAL.XLSB」に登録する。

個人用マクロブックの作り方は↓の真ん中あたりを参考にして
https://koroko.hatenablog.com/entry/2019/09/10/211811

さらにクイックアクセスツールバーにマクロを登録する。
①ファイル→オプションより「クイックアクセスツールバー」を選択する
②マクロを選択する
③「選択範囲を連続番号にする」マクロを選択する
④追加をクリックする
⑤追加した「選択範囲を連続番号にする」マクロを選択する
⑥「変更」をクリックして好きなアイコンを選択する。
⑦「OK」をクリックする

オートフィル風の出来上がり!

もちろん、横方向にも、飛び飛びでもできるよ。


「あいうえお」の場合は「ぁあぃい、かが」など並び順が不規則なので注意!
また普通の数字もできないです。
その場合はこちらを参考に。

Sub 選択範囲を連続番号にする()

    Dim ran As Range
    Dim buf As Long

    '数字の場合
    If IsNumeric(Selection(1).Value) Then

        For Each ran In Selection

            If ran = Selection(1) Then

                buf = ran.Value

            Else

                buf = buf + 1
                ran = buf

            End If

        Next ran

    '日付の場合
    ElseIf IsDate(Selection(1).Value) Then

        Dim mydate As Date

        For Each ran In Selection

            If ran = Selection(1) Then

                mydate = ran.Value

            Else


                mydate = mydate + 1
                ran = mydate


            End If

        Next ran


    '「あいうえお」の場合(ぁあぃい、かが、など並び順が不規則なので)
    ElseIf InStr("あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをん", Selection(1).Value) Then

        Dim i As Long
        For Each ran In Selection

            If ran = Selection(1) Then

                'Acsコードに変換
                buf = Asc(ran.Value) + 1

            Else

                Do

                    If InStr("あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをん", Chr(buf)) Then

                        ran = Chr(buf)
                        buf = buf + 1
                        Exit Do

                    Else

                        buf = buf + 1

                    End If

                Loop

            End If

        Next ran

    '他(①とかAとか)
    Else

        For Each ran In Selection

            If ran = Selection(1) Then

                'Acsコードに変換
                buf = Asc(ran.Value)

            Else

                '文字コードに戻す
                buf = buf + 1
                ran = Chr(buf)

            End If

        Next ran

    End If

End Sub

シフトJIS」表を見ながらオリジナルの連続番号を作ってみよう!

VBA ひな型を壊さないようにするには?(ひな型の形を変える処理がある場合)

こんにちは。
派犬事務員のコロ子です。

前回からの続き
koroko.hatenablog.com

で、
「転記の処理の途中で、行を削除したり、列を追加したり、ひな型の形を変更する処理がある場合はどーするの?」

ですよね?

この場合は、さらに作業用のシートを用意するので、ちょっとややこしい。

① ひな型をコピーする(作業ブック)
② 作業ブックを開く
③ リストデータの数だけループ
  【ループの中で】
  ③-1 作業ブックのひな型シートをコピーする(作業シート)
  ③-2 作業シートを処理
  ③-3 作業シートを名前を付けて保存する
  ③-4 作業シートを削除する
④ 作業ブックを閉じる
⑤ 作業ブックを削除

リストデータの数だけ、シートをコピーしたり、削除したりするので、ちょっと重い処理になる。もっと良い方法があるのかもしれないけど、ひとまずコードを書いてみた。

Sub 注文書作成_3()

    Application.ScreenUpdating = False

    
    '作業用ブックの名前は「作業用年月日時分秒.xlsx」にする
    Dim tmp As String
    tmp = "\作業用" & Format(Now, "yyyyddmmhhnnss") & ".xlsx"

    '注文書ひな型をコピーして作業ブックを作成する
    FileCopy ThisWorkbook.Path & "\注文書ひな型.xlsx", ThisWorkbook.Path & tmp
    

    Dim wb As Workbook
    Dim ws As Worksheet
    
    '作業用ブックを開く
    Set wb = Workbooks.Open(ThisWorkbook.Path & tmp)

    Dim i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
        'ひな型シートを別シートにコピーする。
        wb.Worksheets("ひな型").Copy After:=Worksheets("ひな型")
        Set ws = ActiveSheet
    
        Dim strName As String
        strName = Cells(i, 2).Value
        
        '途中ポイントごとに作業ブックを保存する
        wb.Save
        
        'リストのデータを作業用ブックに転記
        ws.Range("C5").Value = strName '名前
        ws.Range("C10").Value = Cells(i, 1).Value '日付
        ws.Range("D10").Value = Cells(i, 3).Value '品名
        ws.Range("E10").Value = Cells(i, 4).Value '金額
        
        '行を削除する処理とか
        ws.Rows("12:20").Delete
        
        'wsシートを別ブックにコピー
        ws.Copy
        
        '名前を付けて保存
        ActiveSheet.Parent.SaveAs ThisWorkbook.Path & "\領収書(" & strName & ").xlsx"
        
        '閉じる
        ActiveSheet.Parent.Close
        
        'wsを削除
        ws.Delete
        
    Next i
    
    '作業用ブックを閉じる
    wb.Close SaveChanges:=False
    
    '作業ブックを削除
    Kill ThisWorkbook.Path & tmp
    
    Application.ScreenUpdating = True

End Sub

VBA ひな型を壊さないようにするには?

こんにちは。
派犬事務員のコロ子です。

今月から「ノンプログラマーのためのスキルアップ研究会」初心者講座VBA コース6期が始まりました。講師はichihuku@VBAerさんです。コロ子は僭越ながらTA(ティーチングアシスタント)をさせて頂いてます。

TAは何度やっても勉強になる

コロ子ばっかり何度もTAやらせてもらってありがとうございます。TAは本当に何度やっても勉強になる。
ノンプロ研の講座は事前課題がかなり大量に出るけど、みんなちゃんとやってくるのがすごい。事前課題でもらった質問の解決法を書いてみます。

ひな型が上書きされちゃう問題

【課題】
元の課題はこれだけど、
atmarkit.itmedia.co.jp

説明を簡単にするためにちょっとアレンジします。

下記の書式の注文書を

注文書ひな型.xlsx

リストのデータ分だけ作りたい。

リスト.xlsm

【作成方法】
① 注文書ひな型を開く
② リストデータを注文書ひな型に転記する
③ 名前をつけて保存(ファイル名:注文書(名前).xlsx)
④ ②③をリストのデータの数だけ繰り返す
⑤ 注文書ひな型を閉じる(保存しない)


リスト.xlsmのシートモジュールに下記コードを記載する

Sub 注文書作成()

    Dim wb As Workbook
    Dim ws As Worksheet
    
    '注文書ひな型を開く
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\注文書ひな型.xlsx")
    Set ws = wb.Worksheets("ひな型")
    
    'リストをデータの数だけループする
    Dim i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
        'リストのデータをひな形に転記
        
        Dim strName As String
        strName = Cells(i, 2).Value
        
        ws.Range("C5").Value = strName '名前
        ws.Range("C10").Value = Cells(i, 1).Value '日付
        ws.Range("D10").Value = Cells(i, 3).Value '品名
        ws.Range("E10").Value = Cells(i, 4).Value '金額
        
        'ブックを別名で保存
        wb.SaveAs ThisWorkbook.Path & "\注文書(" & strName & ").xlsx"
        
    Next i
    
    '注文書ひな型を閉じる(保存しない)
    wb.Close

End Sub

コードを実行すると、各々の注文書ができている。

注文書ができてる

このような処理は本当に良く使う。

で、頂いた質問は「注文書ひな型にデータが入った状態で上書きされちゃった」
うわー、これ、本当によくある!
そして、ひな型が上書きされると非常に困ることも良くある。
処理の途中で行を追加したり削除したりしてる場合などは最悪!
(このサンプルでは問題ないけど。)

上書きされる原因は、処理の途中で何らかのエラーが出て止まってしまった場合、ひな型をうっかり上書き保存しちゃった、がほとんどだと思う。あのフロッピーマークは無意識に押してしまう。

コード作成中にもあり得るし、運用中にもあり得る。(自分以外の人が使う場合は絶対落ちないコードを書かなくちゃいけないけど、それは今は置いておこう)
そうなると、舌打ちしながらひな型を元に戻す作業が生じる。

そんな場合の解決法は
①ひな型をコピーする(作業ブック)
 FileCopy コピー元ブック名, コピー先ブック名
②作業ブックを開いて処理する
③途中、要所要所で作業ブックを上書き保存
④作業ブックを閉じる
⑤作業ブックを削除
 Kill ファイル名

エクセルを開いて作業してるときに勝手にできるテンポラリーファイルみたいなイメージかな?(ちょっと違う?)

作業ブックを使って処理しているので、途中エラーで止まってしまっても元のひな型はそのままなので安心。
正常に終了していれば、作業ブックは削除されているので、作業ブックが存在していたら、何かしらエラーで止まったことが分かる。さらに要所要所で保存しているので、自分以外の人が使った場合、エラーの場所が推測がしやすくなる。

Sub 注文書作成_2()

    
    '作業用ブックの名前は「作業用年月日時分秒.xlsx」にする
    Dim tmp As String
    tmp = "\作業用" & Format(Now, "yyyyddmmhhnnss") & ".xlsx"

    '注文書ひな型をコピーして作業ブックを作成する
    FileCopy ThisWorkbook.Path & "\注文書ひな型.xlsx", ThisWorkbook.Path & tmp
    

    Dim wb As Workbook
    Dim ws As Worksheet
    
    '作業用ブックを開く
    Set wb = Workbooks.Open(ThisWorkbook.Path & tmp)
    Set ws = wb.Worksheets("ひな型")
    
    Dim i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        
        Dim strName As String
        strName = Cells(i, 2).Value
        
        '途中ポイントごとに作業ブックを保存する
        wb.Save
        
        'リストのデータを作業用ブックに転記
        ws.Range("C5").Value = strName '名前
        ws.Range("C10").Value = Cells(i, 1).Value '日付
        ws.Range("D10").Value = Cells(i, 3).Value '品名
        ws.Range("E10").Value = Cells(i, 4).Value '金額
        
        'ブックを別名で保存
        wb.SaveAs ThisWorkbook.Path & "\注文書(" & strName & ").xlsx"
        
        wb.Save
        
    Next i
    
    wb.Close
    
    '作業ブックを削除
    Kill ThisWorkbook.Path & tmp

End Sub

どうでしょうか?

ActiveXコントロール チェックボックスでフィルターOn/Off

こんにちは。
派犬事務員のコロ子です。

最近ブログサボってました・・・。


オートフィルターって便利だけど、▽クリックして、検索文字を入力したり、チェックボックスをポチポチしたり、なんかめんどくさい。

f:id:SNegishi:20220123181840p:plain
検索したり、ポチポチしたり

色で検索できたり、多機能だけど、日常的には文字列での検索しか使ってない。

f:id:SNegishi:20220123182606p:plain

こんな表に新規のデータを入力する。

コロ子:えっと、会社名は○○
Aさん:ちゃんと○○株式会社と入力してください。後でフィルターするときの検索が面倒になるので。
コロ子:はい。すみません。
コロ子:フルーツ、すいか
Aさん:フルーツじゃなくて果物と入力してください。それから、すいかは果物ではなく野菜です。
コロ子:すみません・・・。
Aさん:入力するときに過去に同じようなのがあるのでそれを参考にしてください。
オートフィルターで絞って探せますよ。前回の入力時に注意事項も入力しているので、そちらも必ず参考にしてください。
コロ子:はい・・・。

フィルタでポチポチしながらデータを絞る。
○○株式会社はみかんだけど、オレンジでもいいのかー。注文書に今回はグレープフルーツも可とかいてある。よし、備考に書いておこう。
△△株式会社の胸肉は皮なしなのね。

最初はいいけど、これを1日何十回。
フィルタの解除も▽をクリックして「全て選択」をポッチ。しかも解除すると、なんかへんな位置にカーソルが行ってる。今入力してるの一番下の行なんだけど!
ちっちゃいイラっとも溜まればストレス。
なのでチェックボックスのOn/Offでフィルターできる機能を付けてみた。

チェックオン:カーソル位置の値で絞る
チェックオフ:絞り解除。元のカーソル位置に戻る

ActiveXコントロール チェックボックス

先ずは、チェックボックスを挿入する

開発タブ

挿入

チェックボックス
を選択する
f:id:SNegishi:20220123205921p:plain

先頭行に配置する
f:id:SNegishi:20220123210343p:plain

先頭行は固定にしておく。(フィルター機能付けてるので当然だけど)
f:id:SNegishi:20220123211153p:plain


準備できたらコードを書いてみよう。
ActiveXコントロールはシートのイベントが使える。素晴らしい!

f:id:SNegishi:20220123212005p:plain

シートモジュールのオブジェクトボックスに先ほど作成したCheckBox1~5がいる。
となりのプロシージャボックスからClickを選択する。

'最初のカーソル位置を記憶しておく
Private myRan As Range 

Private Sub CheckBox1_Click()
    Call CheckBox_Filter(CheckBox1.Value, 3)
End Sub

Private Sub CheckBox2_Click()
    Call CheckBox_Filter(CheckBox2.Value, 4)
End Sub

Private Sub CheckBox3_Click()
    Call CheckBox_Filter(CheckBox3.Value, 5)
End Sub

Private Sub CheckBox4_Click()
    Call CheckBox_Filter(CheckBox4.Value, 6)
End Sub

Private Sub CheckBox5_Click()
    Call CheckBox_Filter(CheckBox5.Value, 7)
End Sub
'ckBox As Boolean チェックボックス値(オン/オフ)
'c As Long フィルターする列
Private Sub CheckBox_Filter(ckBox As Boolean, c As Long)

    Application.ScreenUpdating = False
    
    If ckBox Then
    
        '元のカーソル位置を記憶(チェックボックスが全てオフのとき)
        If myRan Is Nothing Then
            Set myRan = ActiveCell
        End If
        
        '元のカーソル行でチェックが入ったチェックボックスの列の値を含む文字列でフィルタする
        Dim searchStr As String
        searchStr = Cells(myRan.Row, c)
        
        Range("A1").AutoFilter c, "*" & searchStr & "*"
        
    Else
    
        Range("A1").AutoFilter 'オートフィルタをはずす
        Range("A1").AutoFilter 'オートフィルタを付ける
    
        '全てのチェックボックスのチェックをはずす
        Dim ckb As OLEObject
    
        For Each ckb In OLEObjects
    
            If InStr(ckb.Name, "CheckBox") <> 0 Then
                ckb.Object.Value = False
            End If
    
        Next
        
        Application.ScreenUpdating = True
        
        '最初の位置を選択してmyRan変数をリセット
        If Not myRan Is Nothing Then
            myRan.Select
            Set myRan = Nothing
        End If

    End If
    
Application.ScreenUpdating = True
    
End Sub

Range("A1").AutoFilterはオートフィルターがない場合はつける、ついている場合は外す。
Range("A1").AutoFilterでオートフィルターを外すと絞り込みを解除するだけではなく、オートフィルター自体も解除されてしまうので、もう一度Range("A1").AutoFilterでオートフィルターを付ける。何かダサいので多分もっといい方法があると思う。

複数チェックボックスにチェックを外す場合
ckb.Object.Value = False
でいちいちイベントが発生してしまう。
Application.EnableEvents = False
ckb.Object.Value = False
Application.EnableEvents = True
でイベントの発生を無効にしようと思ったけど、上手くいかない。
ActiveXコントロールはApplicationのイベントではないのかな?

なので何度もこの処理を通るため、元の位置に戻るときにmyRanがnothingかどうか判定した。

【結果】
超快適!


ちなみにActiveXコントロールのプロパティは
①開発タブ

②デザインモード

③対象のオブジェクトを選択

④プロパティ
から設定できる。
設定し終わったらデザインモードをオフにするのを忘れずに。
f:id:SNegishi:20220124062330p:plain

プルダウンでなくてユーザーフォームで選ぶ(プルダウンの文字数が多い場合)

こんにちは。
派犬事務員のコロ子です。

以前書いた「連動したプルダウンを作る」の記事に「リストに入れる文字数が多くなるとVBAが壊れる現象が起きる」というコメントを頂いて、調べてみたら、プルダウンリストには255文字までしか入らないらしい。

tonari-it.com

おお!知らなかった。
でも、コロ子のコードでは「名前付き範囲を指定する」方法なので文字制限は気にしなくて良さそう。実際試してみたら255文字以上も大丈夫だった。

どういう状態なのかな。大丈夫かな?
状況が良く分からないけど、プルダウンで長い文字を選択するのはちょっと大変そう。
そこで、長~い文字を簡単に入力するにはどうすれば良いか考えてみた。
VLOOKUPのパワーアップ版のイメージでユーザーフォームを使うのはどうだろうか?

【例】
この表のコメント列を入力したい。
プルダウンで選択するには文字列が長すぎる。

一覧表シート


①長い文字列の選択用のシートを作成する(選択用コメントシート)

A列:見出し
B列:長い文字列(内容)


②ユーザーフォームを作成する

・表のD列でダブルクリックをするとユーザーフォームが立ち上がる。
・ユーザーフォームのリストに見出しが出る。
・見出しを選択すると、テキストボックスに内容が表示される。
 テキストボックス内で内容の変更も可能。
・OKボタンを押すと表のコメント欄に内容が入る。

ではユーザーフォームを作ってみよう。

ユーザーフォーム名:UserForm2(いろいろいじっていたら2になっちゃった)
上のボックス:ListBox1
下のボックス:TextBox1
※TextBox1は改行可にするためにプロパティのEnterKeyBehavior をTrueにする。
OKボタン:CommandButtonで作成。オブジェクト名もCaptionも「OK」

コード

【Sheet1(一覧表シート)】

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    'D列をダブルクリックした時ユーザーフォームを立ち上げる
    
    If Target.Column = 4 Then
    
        UserForm2.Show
    
    End If

End Sub


【ユーザーフォーム】

'ユーザーフォームが開くタイミングで実行される
Private Sub UserForm_Initialize()

    Dim i As Long
    Dim ws As Worksheet
    
    Set ws = Sheets("選択用コメント")

    For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    
        'リストボックスに見出しを追加
        ListBox1.AddItem ws.Cells(i, 1).Value
        
    Next i

End Sub
'ListBox1(見出し)を選択した時
Private Sub ListBox1_Click()

    Dim i As Long

    i = ListBox1.ListIndex

    'ListBox1のインデックス番号は0から始まる&2行目から始まる→+2
    TextBox1.Value = Sheets("選択用コメント").Cells(i + 2, 2).Value

End Sub
'OKボタンを押した時
Private Sub OK_Click()

    ActiveCell.Offset(0, -1).Value = TextBox1.Value
    
    'ユーザーフォームを閉じる
    Unload UserForm2

End Sub

これじゃダメかな?