ユーザーフォームの入力項目をバックアップするVBA

tyusenbackupeyecatch

ユーザーフォームを再表示した時に、消えてしまった入力項目を簡単に再表示させることができます。
入力項目をバックアップして表示復旧を行えるようにします。

こんにちは、じゅんぱ店長(@junpa33)です。

今回のエクセルVBA抽選ソフト作成の解説は、

「ユーザーフォーム」に記入した事項をバックアップ保存するためのコードの作成についてです。

ユーザーフォーム上のコマンドボタンから、入力していた項目の再表示を行えるようにします。

ユーザーフォームの入力項目は保存しておきたい

tyusenbackup004pkai

ユーザーフォームの入力項目を、なぜバックアップする必要があるのでしょうか?

理由は、ユーザーフォームは簡単に非表示になってしまうからです。

ユーザーフォームが一旦非表示になると、

それまでセットしていたユーザーフォームの入力事項がすべてクリアされてしまうのです。

するとどうなるか?

ユーザーフォームを使うためには再度1から項目入力しなければなりません。

もしユーザーフォームが非表示ななる前に、

入力事項がプログラムに値として取り込まれていたら

更にそのエクセル本体を終了していなければ、入力値としては保持されてはいます。

(この場合でもユーザーフォームの非表示原因がプログラムコードエラーなら、入力値としても保存されませんが・・・)

一旦、ユーザーフォームが消えてしまえば、入力データがプログラム上保持されていても、ユーザーフォーム上で確認することはできません。

こんな面倒なことが起こってしまうことが、入力事項をバックアップしておきたいという理由です。

ユーザーフォーム上の入力項目の保存の方法

tyusenbackup005pkai

抽選項目BUシートに、ユーザーフォームの入力項目を転記します。

「抽選項目登録」ボタンの場合

ユーザーフォームの「抽選項目登録」ボタンが押されたとき、入力項目の値が変数に代入されるのと同時に、

Module4に記述されている「抽選項目バックアップ」プロシージャーで、

入力項目データを抽選項目BUシートに転記します。

この「抽選項目登録」ボタンをクリックしたときは、新しいバックアップとしてそれまでのデータがリセットされます。

「抽選項目更新」ボタンの場合

ユーザーフォームの「抽選項目更新」ボタンが押されたときは、

Module4に記述されている「抽選項目バックアップ旧データ」プロシージャーによって、

抽選項目BUシート上で、先の「抽選項目登録」の時にバックアップされた入力項目データを下方向に移動します。

更に、今、入力されているユーザーフォームの入力項目をバックアップ位置に転記します。

Module4に記述されている「抽選項目更新」プロシージャーによって、

更新された項目を含めて、再度、抽選項目が変数に代入され変数値が更新されます。

抽選状況一覧において、賞名が更新された新しい賞名に変更されます。

「抽選方法12か所」ボタンの場合

各賞の「単発」と「連続」ボタンを押して抽選を行った時にも

「抽選項目更新」ボタンを押したときと同じバックアップが行われます。

常に最新の状況としてバックアップします。

バックアップのプロシージャー作成

tyusenbackup006pkai

Module4に記述していきます。

「抽選項目バックアップ」プロシージャー

「抽選項目登録」ボタンをクリックしたときに実行されるプロシージャーを設計します。

tyusenbackup001kai
宣言変数
  • i、j・・・・ カウンター変数
  • BUsheet・・・・ 抽選項目BUシート
  • Title・・・・ 抽選名称
  • Par・・・・ 参加人数(口)
  • EVD・・・・ 開催日付
  • PrN()・・・・ 賞名
  • PrQ()・・・・ 当選本数

抽選項目BUシートのA列からC列、1から10行目にバックアップを作ります。

VBA
Option Explicit

Sub 抽選項目バックアップ()
    Dim i, j As Long
        Set BUsheet = Worksheets("抽選項目BU")
        BUsheet.Select
        Cells.Clear
        For i = 101 To 109
           Cells(1, 1) = "抽選項目"
           Cells(1, 2) = "設定値"
           Cells(1, 3) = "当選本数"
           Cells(i - 100 + 1, 1) = 選定ナビ.Controls("Label" & i).Caption
        Next i
        Range("B2") = TItle
        Range("B3") = Par
        Range("B4") = EVD
        For j = 1 To 6
            Range("B" & 4 + j) = PrN(j)
            Range("C" & 4 + j) = PrQ(j)
        Next j
        Columns("A:C").AutoFit
End Sub

「抽選項目バックアップ旧データ」プロシージャー

「抽選項目更新」ボタンをクリックしたときに実行されるプロシージャーを設計します。

tyusenbackup002kai
宣言変数
  • i・・・・ カウンター変数
  • BUsheet・・・・ 抽選項目BUシート
  • TYsheet・・・・ 抽選会場シート

抽選会場シートのセルA1が「空白」の場合はプロシージャーを実行しません。
(セルA1が空白になっているの状態は、この抽選ソフトが使われていない初期の状態の時です。)

「賞名」がデフォルトの「(仮)賞」も入力されていない状態の時があれば、

デフォルトの「(仮)賞」を強制表示させるプロシージャー「賞名空白対処」を呼び出します。

VBA
Sub 抽選項目バックアップ旧データ()
    Dim i As Long
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        BUsheet.Select
        Call Module4.賞名空白対処
        For i = 1 To 10
            Range("A" & 12 + i) = "旧 " & Range("A" & i)
            Range("B" & 12 + i) = Range("B" & i)
            Range("C" & 12 + i) = Range("C" & i)
        Next i
        With 選定ナビ
            Range("B2") = .抽選名称.Value
            Range("B3") = .参加人数.Value
            Range("B4") = .開催日付.Value
            Range("B5") = .一位賞.Value
            Range("B6") = .二位賞.Value
            Range("B7") = .三位賞.Value
            Range("B8") = .四位賞.Value
            Range("B9") = .五位賞.Value
            Range("B10") = .六位賞.Value
            Range("C5") = .一位本.Value
            Range("C6") = .二位本.Value
            Range("C7") = .三位本.Value
            Range("C8") = .四位本.Value
            Range("C9") = .五位本.Value
            Range("C10") = .六位本.Value
        End With
        Columns("A:C").AutoFit
End Sub
vbacalleyecatch 部品化プロシージャーでCallステートメントは必須

「抽選項目更新」プロシージャー

「抽選項目更新」ボタンをクリックしたときに実行されるプロシージャーを設計します。

宣言変数
  • i、j、k・・・・ カウンター変数
  • FArow・・・・ 抽選会場シートの抽選一覧表の賞名列の最終行
  • BUsheet・・・・ 抽選項目BUシート
  • TYsheet・・・・ 抽選会場シート
  • Title・・・・ 抽選名称
  • Par・・・・ 参加人数(口)
  • EVD・・・・ 開催日付
  • PrN()・・・・ 賞名
  • PrQ()・・・・ 当選本数
  • PrQn()・・・・ 当選本数(数値型)

抽選一覧表の賞名のさかのぼり修正は、

抽選項目バックアップの賞名の新旧を比較して差異がある場合は、

旧賞名を新賞名に置き換えるという作業を行っています。

VBA
Sub 抽選項目更新()
    Dim i, j, k As Long
    Dim FArow As Long
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        BUsheet.Select
        TItle = Range("B2")
        Par = Range("B3")
        EVD = Range("B4")
        Call Module4.賞名空白対処
        For i = 1 To 6
            PrN(i) = Range("B" & 4 + i)
            PrQ(i) = Range("C" & 4 + i)
            PrQn(i) = val(StrConv(PrQ(i), vbNarrow))
            TYsheet.Range("C" & 4 + i) = PrQn(i) - TYsheet _
                .Range("B" & 4 + i)
        Next i
        TYsheet.Select
        If Range("A1") = "" Then
            Range("C:C").ClearContents
        End If
        For j = 1 To 6
            TYsheet.Range("A" & 4 + j) = BUsheet. _
                Range("B" & 4 + j)
        Next j
'抽選会場当選結果、賞名のさかのぼり修正
        FArow = TYsheet.Cells(Rows.Count, 1).End(xlUp).Row
        BUsheet.Select
        For j = 1 To 6
            If Range("B" & 4 + j) <> Range("B" & 16 + j) Then
                For k = 12 To FArow
                    If TYsheet.Range("A" & k) = BUsheet _
                        .Range("B" & 16 + j) Then
                        TYsheet.Range("A" & k) = BUsheet _
                            .Range("B" & 4 + j)
                    End If
                Next k
            End If
        Next j
        TYsheet.Select
End Sub
VBAValeyecatch Val関数はデータ型不一致の解決策。文字列型から数値型へ vbacalleyecatch 部品化プロシージャーでCallステートメントは必須 vbaifjyokeneyecatch If条件文のVBAコードの組み方。条件の絞り方を最速理解

「賞名空白対処」プロシージャー

宣言変数
  • i・・・・ カウンター変数

それぞれの賞名が空欄で、かつ当選本数が入力されている場合に「(仮)賞」をユーザーフォームのテキストボックスに表示します。

VBA
Sub 賞名空白対処()
    Dim i As Long
        For i = 1 To 6
        
            If 選定ナビ.一位賞.Value = "" And _
                選定ナビ.一位本.Value <> "" Then
                        選定ナビ.一位賞.Value = "(仮)1位賞"
            ElseIf 選定ナビ.二位賞.Value = "" And _
                選定ナビ.二位本.Value <> "" Then
                        選定ナビ.二位賞.Value = "(仮)2位賞"
            ElseIf 選定ナビ.三位賞.Value = "" And _
                選定ナビ.三位本.Value <> "" Then
                        選定ナビ.三位賞.Value = "(仮)3位賞"
            ElseIf 選定ナビ.四位賞.Value = "" And _
                選定ナビ.四位本.Value <> "" Then
                        選定ナビ.四位賞.Value = "(仮)4位賞"
            ElseIf 選定ナビ.五位賞.Value = "" And _
                選定ナビ.五位本.Value <> "" Then
                        選定ナビ.五位賞.Value = "(仮)5位賞"
            ElseIf 選定ナビ.六位賞.Value = "" And _
                選定ナビ.六位本.Value <> "" Then
                        選定ナビ.六位賞.Value = "(仮)6位賞"
            End If
        Next i
End Sub

「当選者リスト作成」プロシージャー

「抽選結果を保存」ボタンをクリックしたときに実行されるプロシージャーを設計します。

tyusenbackup003kai

バックアップ関連でModule4に「当選者リスト作成」プロシージャーを記述します。

当選者シートに当選者リストをコピーでバックアップします。

当選者リストを作成する度に、前回作成分に上書きされます。

ソフトの「強制初期化」を行うと当選者シートそのものがクリアされます。

安全に保存するためには、別のエクセルファイルに内容をコピー保存してください。

VBA
Sub 当選者リスト作成()
    Dim LCRow As Long
        Set TYsheet = Worksheets("抽選会場")
        Set TOsheet = Worksheets("当選者")
        If TYsheet.Range("A1") = "" Then Exit Sub
        TOsheet.Select
        Cells.Clear
        TYsheet.Select
        LCRow = TYsheet.Cells(Rows.Count, 3).End(xlUp).Row
        Range(Cells(3, 1), Cells(LCRow, 3)).Copy TOsheet.Range("A3")
        TOsheet.Select
        With TOsheet
            .Columns("A:C").AutoFit
'選定ナビ.抽選名称.Value
            .Range("A1") = TItle
'選定ナビ.開催日付.Value
            .Range("C1") = EVD
'選定ナビ.参加人数.Value & "人(口)"
            .Range("A2") = Par & "人(口)"
            With .Range("A1,A2,C1").Font
                .Bold = True
                .Size = 13
            End With
        End With
        TYsheet.Select
End Sub
vbalastcelleyecatch データ入力済セルの最終行番号を取得する vbawithstateeyecatch With~End Withの使い方。VBAコードを簡潔に記述する

入力項目のバックアップ まとめ

tyusenbackup007pkai

ユーザーフォームを非表示にしてしまうと、再表示時には入力した項目がすべてクリアされています。
(このソフトでは、デフォルトで「(仮)賞」がテキストボックスに表示されるようになっています。)

「抽選項目登録」や「抽選項目更新」ボタンをクリックして、「選定ナビ」ユーザーフォームの入力データを保存していた場合は、

「抽選名称復旧」や「抽選項目復旧」ボタンでユーザーフォームの入力表示状態を前に戻すことが出来ます。

結構あれば便利に利用できると思います。

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。

vbastudyeyecatch2 エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

今回の記事はここまでです。   最後までご覧いただき有難うございました。

エクセルVBA最速理解で必要な知識を集めよう!

エクセルVBA業務ツールで日常の業務改善を行いましょう。

<記事内容についての告知>VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。