以前紹介した「車庫証明」アプリですが、何回にも分かれた細切れ状態だったので
まとめてみました。
上は架空のマンションの駐車場です。３階建てとします。
１階は?ｂP〜?ｂP０・２階は?ｂP１〜?ｂQ０・３階は?ｂQ１〜?ｂR０とします。
架空のマンションの住人を上記の名簿の方とします。
マンションは６階建てでワンフロアに５部屋とします。
分かりやすいように順番に駐車場を契約しているとします。
※１０５号室は契約者と使用者が違うという事にします。（賃貸という事です）
上記のような標準的な「車庫証明」とします。
これはExcelシートで作ってくださいね。
具体的なイメージとして
・部屋番号を入力し、「発行ボタン」を押すと自動的に部屋番号・電話番号・枠番号・
使用者と契約者の関係・使用者と契約者の氏名が記載された「車庫証明」が印刷され、
一緒に「駐車区画」と周辺地図が印刷され、発行した履歴が残るという動作を考えています。
実際は戸数も５００戸あり、駐車場も５００台あります。
またマンションの所有者と車両の所有者が違う「賃貸」の場合とか、
同じ家庭内でも使用者が違う場合とかがありますね。
そのあたりの様々な条件を踏まえて作成しております。
今回はある程度端折っているので少し簡単になると思います。
それでもできるだけ実際に近い形でご紹介したいと思います。
今エクセルのページとしては「メイン」「名簿」「車庫証明」「車庫図面」「地図」
「発行履歴」と６ページあります。
実際はメインページを入力ページとして、そこに入力セル・発行ボタンを配置しています。
今回はせっかくなので入力フォームを作ってみましょう。
メインページを選択（アクティブ）すると入力フォームが開くという事にしましょう。
入力フォームの内容
・部屋番号を入力するテキストボックス
・使用者と契約者の関係を選択する「オプションボタン」の設置と、
その他を選択した場合の記入用テキストボックス
・発行ボタン
一応上記くらいですね。
実際は１家庭で２台以上持っておられる方もいますので、駐車場のデータベースもあり、
居住者のデータベースと別になっています。
そのため、「部屋番号」と「駐車場番号」の両方を入力するようになっていて、
整合性がなければ赤表示になり間違いを示唆するようになっています。
とりあえず入力フォームを作ってみました。
「部屋番号を入力してください」というところは「ラベル」ですね。
そしてフレームを入れて「使用者と契約者の関係」という名前を付けています。
その他の下にあるテキストボックスは「その他」の場合にどのような関係か記入するところです。
部屋番号を入力するテキストボックスは数字が入るのでフォームのテキストボックスの
プロパティの中にある「ＩＭＥＭｏｄｅ」で「8-fmIMEModeAlpha」にします。
ここの設定の詳細ですが
0-fmIMEModeNoControl・・・IMEのモードを変更しない
1-fmIMEModeOn・・・IMEをONにします
2-fmIMEModeOff・・・IMEのモードOFFにします
3-fmIMEModeDisable・・・IMEのモードをOFFにします。
このモードではユーザーのキー操作でもIMEをONする
ことはできなくなります
4-fmIMEModeHiragana・・・全角ひらがなにします
5-fmIMEModeKatakana・・・全角カタカナにします
6-fmIMEModeKatakanaHalf・・・半角カタカナにします
7-fmIMEModeAlphaFull・・・全角英数モードにします
8-fmIMEModeAlpha・・・半角英数モードにします
上記のようにテキストボックスのIME設定が出来ます。
最初にメインページにフォームを開くボタンを設置しましょう。
メインページに「車庫証明発行」ボタンを設置しました。
フォームを開くVBAを記載しています。
メインページの「車庫証明発行」ボタンを押すと上記のようにフォームが開きます。
ここから「印刷」ボタンのＶＢＡを考えて行きましょう。
動作として考えなくてはいけない点を順不同で列挙していきます。
・「使用者と契約者の関係」で初期状態を「同じ」に設定する。
・部屋番号が入力されていない状態で「印刷」ボタンを押された場合の動作
・・・「部屋番号を入力してください」というメッセージを表示。
・「使用者と契約者の関係」で「その他」を選択された場合は、
関係性を記入してもらう必要があるが、記入せずに「印刷」ボタンを押された場合の動作。
・・・関係性を入力してくださいというメッセージを表示。
・部屋番号を車庫証明シートの２か所に入力
・氏名（使用者と契約者の２か所）の入力
・電話番号の入力・・・これも２か所
・使用者と契約者の欄に丸数字で入力し、その他の場合は関係性を入力する
・車庫図面の該当区画に色を付ける
・車庫証明の印刷
・車庫図面の印刷（該当ページのみ）
・地図の印刷
・発行履歴への記載
大体このくらいでしょうか。
それから後でこのフォームに「終了」ボタンと取扱い説明を追加しましょう。
もう一つ、一度発行して、終了するとその方の部屋番号・名前・電話番号等々と
車庫図面の色が残ったままですね。次に作成するときに残ったままだと
好ましくないのでどこかのタイミングで初期化しましょう。
印刷ボタンを押して、最初にその処理を入れるか、または印刷終わってから
処理を入れるかですか、大体私は最初に入れております。
印刷後に入れた場合、何らか不具合等で印刷が実行できなかった場合、
初期化されていると入力からやり直す必要があります。
最初に処理を入れておけば、印刷が失敗しても、データーは残っているので、
個別で印刷すればＯＫだからです。
このくらいの要素を入れてＶＢＡを作成すれば問題ないでしょう。
実際は使用者と契約者の電話番号も違うので別々の処理を入れています。
また使用者と契約者が同じ場合は「同じ」というボタンを入れて処理しています。
また駐車場図面は２シートあって全部で６ページあります。
それ以外に「車庫証明発行に際して」という注意文書も一緒に印刷しております。
Hulu
とりあえずフォームに終了ボタンと説明書を追加しましょう。
説明と「終了」ボタンを追加して、レイアウトも若干さわりました。
・最初に前回のデータを消去することから始めましょう。
フォームの「印刷」ボタンをダブルクリックしてＶＢＡを記載できるようにして
下記のコードを書きました。
Private Sub CommandButton1_Click()
Sheets("車庫証明").Range("g6").ClearContents
Sheets("車庫証明").Range("g9").ClearContents
Sheets("車庫証明").Range("m7").ClearContents
Sheets("車庫証明").Range("m10").ClearContents
Sheets("車庫証明").Range("f7:g7").ClearContents
Sheets("車庫証明").Range("f10:g10").ClearContents
Sheets("車庫証明").Range("n4:r4").ClearContents
Sheets("車庫証明").Range("p6:p9").ClearContents
Sheets("車庫証明").Range("p6") = 1
Sheets("車庫証明").Range("p7") = 2
Sheets("車庫証明").Range("p8") = 3
Sheets("車庫証明").Range("p9") = 4
End Sub
とにかく一つ一つ書いてあるので非常に分かりやすいと思いますので説明は省きます。
ClearContentsもまとめて指定することも出来ます。
例）
Sheets("車庫証明").Range("g6，g9，m7").ClearContentsとすると3つのセルが選択され、
消去されます。
・使用者と契約者の関係ですが、初期状態は「同じ」にしましょう。
上記のように「UserForm」の「Initialize」にして、
Private Sub UserForm_Initialize()
OptionButton1.Value = True
End Sub
上記のように記載しましょう。
フォームを開いたときに「同じ」にチェックが入っています。
・「部屋番号」を入力されないで「印刷」ボタンを押された場合はエラーメッセージが
表示されるようにしましょう。
If UserForm1.TextBox1 = "" Then
MsgBox ("部屋番号を入力してください")
Exit Sub
End If
上記のように記載しました。内容は分かりますね。
上記は部屋番号を記入せずに「印刷」ボタンを押したときの状態です。
次に「使用者と契約者の関係」で「その他」を選択した場合「関係性」を記入しなかった
場合もエラーメッセージを出しましょう。
If UserForm1.OptionButton4 = True Then
If UserForm1.TextBox2 = "" Then
MsgBox ("関係性を入力してください")
Exit Sub
End If
End If
上記のように記載しました。
これも非常にシンプルに記述していますので、分かりますね。
上記は部屋番号を入力し、「その他」を選択したが、「関係性」を空白のまま
「印刷」ボタンを押したときの状態です。
ここまでで、最初の仕掛けは出来たと思うので、ここからは入力に従って、
車庫証明にコピーして行きましょう。
注意するところは使用者と契約者が違う場合だけですね。「同じ」を選択した時は、
同じものをコピーすればＯＫですね。
それ以外は使用者（賃貸者）をコピーする。まあ実際はもっと複雑ですが（本店・支店等）、
今回はこのようにしましょう。
名簿の修正
最初に名簿を作成した時、あまり深く考えずに下記のように
氏名・住所・部屋番号・駐車場?ａE電話番号・使用者という並びで作ったのですが、
部屋番号で検索するにはＡ列に「部屋番号」を持ってきた方が良いと判断し、
下記のように修正しました。
簡単に言うと、「部屋番号」を基準にしてVlookup関数を使用したいためです。
Vlookup関数は検索するセルから見て右側しか抽出できません。
もちろん、以前紹介したように、他の関数と組み合わせれば、左側も抽出できるのですが、
今回はシンプルにしたいと思うので上記のように変更して、Vlookup関数だけ使用したいと思います。
それから１０５号室は「賃貸」という前提で進めていますが、本来ならば、
オーナー様は別住所で、賃貸の「塚田さとる」がこの住所という事になります。
本来ならば、契約者の住所と使用者の住所は別になります。
この部分もとりあえず同じにしておきましょう。
初期費用0円！格安スマホ【UQmobile】
車庫証明へのコピー
保管場所の使用者欄でF6に住所・J6に部屋番号・M7に電話番号ですね。
保管場所の契約者欄はF9に住所・J9に部屋番号・M10に電話番号ですね。
それから、枠番号がN4になり、使用者と契約者の関係がP6〜P9になります。
その際、４その他を選択された場合、関係性をQ10にコピーする必要があります。
こちらで使用しているものは先ほど記載したように、オーナー様と賃貸者の両方の住所・
電話番号欄があり、「使用期間」も入力できるようになっています。
後、入力欄には部屋番号と駐車場?ｂﾌ両方を入力するようにしております。
両方ともデータベースがあり、両方の整合性が取れない場合はエラーとなります。
上記のように記載しました。
VBA上で関数を使用する場合は上記のように、
値 = WorksheetFunction.VLookup(検索値,検索範囲, 列数)という記載になります。
現時点、賃貸に関する考慮はされておりません。
Dim n As Long
Dim tbl As Range
Set tbl = Sheets("名簿").Range("a2:g29")
n = UserForm1.TextBox1.Value
Sheets("車庫証明").Range("m7").ClearContents
Sheets("車庫証明").Range("m10").ClearContents
Sheets("車庫証明").Range("j6").ClearContents
Sheets("車庫証明").Range("j9").ClearContents
Sheets("車庫証明").Range("f7:g7").ClearContents
Sheets("車庫証明").Range("f10:g10").ClearContents
Sheets("車庫証明").Range("n4:r4").ClearContents
Sheets("車庫証明").Range("p6:p9").ClearContents
Sheets("車庫証明").Range("q10").ClearContents
Sheets("車庫証明").Range("p6") = 1
Sheets("車庫証明").Range("p7") = 2
Sheets("車庫証明").Range("p8") = 3
Sheets("車庫証明").Range("p9") = 4
Sheets("車庫証明").Range("F6").Value = WorksheetFunction.VLookup(n, tbl, 3, False)
Sheets("車庫証明").Range("j6").Value = WorksheetFunction.VLookup(n, tbl, 1, False)
Sheets("車庫証明").Range("m7").Value = WorksheetFunction.VLookup(n, tbl, 5, False)
Sheets("車庫証明").Range("F9").Value = WorksheetFunction.VLookup(n, tbl, 3, False)
Sheets("車庫証明").Range("J9").Value = WorksheetFunction.VLookup(n, tbl, 1, False)
Sheets("車庫証明").Range("m10").Value = WorksheetFunction.VLookup(n, tbl, 5, False)
Sheets("車庫証明").Range("n4").Value = WorksheetFunction.VLookup(n, tbl, 4, False)
If UserForm1.OptionButton1 = True Then
Sheets("車庫証明").Range("F7").Value = WorksheetFunction.VLookup(n, tbl, 2, False)
Else
Sheets("車庫証明").Range("F7").Value = WorksheetFunction.VLookup(n, tbl, 6, False)
End If
Unload UserForm1
Sheets("車庫証明").Select
上記のように記載しました。
初めの下の部分ですが、ここで変数宣言しております。通常は頭で宣言するのですが、
今回はここでの宣言になっております。
Dim n As Long
Dim tbl As Range
Set tbl = Sheets("名簿").Range("a2:g29")
n = UserForm1.TextBox1.Value
「n」はユーザーフォームのテキストボックスなので、入力された部屋番号となります。
「tbl」は名簿範囲を変数として設定しています。
次に「ClearContents」というのがいくつか並んでいます。
以前一度同じような記述をしましたが、若干範囲を変更しましたので、
以前の部分を削除して、今回クリアを実施しましょう。
次に
Sheets("車庫証明").Range("F6").Value = WorksheetFunction.VLookup(n, tbl, 3, False)
というよく似た内容のものが並んでいます。
これはVlookup関数を使用して部屋番号から抽出した「住所」「部屋番号」「電話番号」を
車庫証明シートにコピーしているところです。
部屋番号は「=n」でもいいのですが、一応Vlookup関数にしております。
あと駐車場?ｂ焜Rピーしております。
VBAで関数を使用する場合はこのように、WorksheetFunction.VLookup
(検索値,検索範囲,列番号)という記述になります。
If UserForm1.OptionButton1 = True Then
Sheets("車庫証明").Range("F7").Value = WorksheetFunction.VLookup(n, tbl, 2, False)
Else
Sheets("車庫証明").Range("F7").Value = WorksheetFunction.VLookup(n, tbl, 6, False) End If
上記の部分ですが、契約者と使用者の関係が「本人」の場合は使用者に契約者の
名前をそのままコピーします。
違う場合は使用者（賃貸者）の名前をコピーします。
Unload UserForm1
Sheets("車庫証明").Select
上記の部分ですが、ユーザーフォーム1を閉じて、「車庫証明」のシートを表示する命令です。
「フォームを閉じる」なので「close」でいいように思えますが、フォームを閉じる場合は
「Unload」を使用してください。
楽天スーパーポイントプレゼント!
・使用者と契約者の関係性のVBA
If UserForm1.OptionButton1 = True Then
Sheets("車庫証明").Range("p6").Value = "?@"
ElseIf UserForm1.OptionButton2 = True Then
Sheets("車庫証明").Range("p7").Value = "?A"
ElseIf UserForm1.OptionButton3 = True Then
Sheets("車庫証明").Range("p8").Value = "?B"
ElseIf UserForm1.OptionButton4 = True Then
Sheets("車庫証明").Range("p9").Value = "?C"
Sheets("車庫証明").Range("q10").Value = UserForm1.TextBox2
End If
「Unload UserForm1」の前に上記のような記述をしました。
ここも分かると思います。
オプションボタン1が選択されていれば、「P6」に「?@」を入れなさいという命令ですね。
オプションボタン４までは同じです。
最後にSheets("車庫証明").Range("q10").Value = UserForm1.TextBox2
というところがありますね。
これは関係性をコピーせよという意味合いです。
ここまでで、車庫証明に必要事項は記載できたと思います。
次は駐車区画に色付けしたいと思います。
Dim m As Integer
m = Sheets("車庫証明").Range("n4") '変数mに駐車場番号を指定
Sheets("車庫図面").Select
Sheets("車庫図面").Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells.Find(what:=m).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
.PatternTintAndShade = 0
End With
上記のような記載をしました。
変数のところは分かりますね。
次の
Sheets("車庫図面").Select
Sheets("車庫図面").Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ここは車庫図面に前回の色が残っているという前提で、シート全部の色の指定を解除しています。
Cells.Find(what:=m).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
.PatternTintAndShade = 0
End With
次にFind関数を用いて車庫番号のセルを探して、色を付けています。
例）
１０５号室を選択して、このVBAを実行させると下記のようになります。
５番のところがピンクになりましたね。
これで指定の駐車場に色が付きました。
エーハチネット
Find関数について
Cells.Find(what:=m).Selectについて
条件に当てはまるセルを探します。
【構文】
Object.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection,
MatchCase, MatchByte, SearchFormat)
・Object・・・Rangeオブジェクト
・What・・・検索するデータを指定します。省略できません。
・After・・・単一のセルを指定。この引数に指定したセルの次のセルから検索を開始します。
省略するとObjectで指定したセル範囲の左上の次のセルから検索します。（省略可能）
・LookIn・・・検索の対象を指定。（省略可能）
数式・・・（xlFormulas）
値・・・（xlValues）
コメント・・・（xlComments）
・LookAt・・・完全に同一のセルだけ検索します。（xlWhole）
一部でも一致するセルを検索。（xlPart）
（省略可能）
・SearchOrder・・・検索方向を指定する。（省略可能）
列方向（xlByColumns）
行方向（xlByRows）
・SearchDirection・・・前方に検索する場合(xlNext：既定値)
後方に検索する場合(xlPrevious)
（省略可能）
・MatchCase・・・大文字と小文字を区別する場合(True)
区別しない場合(False)
（省略可能）
・MatchByte・・・半角と全角を区別する場合(True)
区別しない場合(False)
（省略可能）
・SearchFormat・・・書式を検索する場合(True)
書式を検索しない場合(False)
（省略可能）
上記のような内容になります。
また、条件に当てはまるセルが複数存在する場合は、見つかったセルの次を
検索するためにFindNextメソッドとFindPreviousメソッドを使用します。
・Object.FindNext(After)
・Object.FindPrevious(After)
今回は「what」以外は全て省略して「Cells.Find(what:=m)」となっております。
今回は必ず検索する駐車場が見つかるという前提でVBAを作成していますが、
本来は見つからない場合も想定に入れる必要があります。
見つからない場合はエラーが発生します。
Findメソッドはセルを見つけた場合、そのセルを表すRangeオブジェクトを返し、
見つからなかった場合はNothingを返します。
下に例文を記載します。
Dim Rng As Range
Set Rng = Cells.Find(What:=m)
If Not Rng Is Nothing Then
Cells.Find(what:=m).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
上記のようにすると、もし該当する駐車場?ｂｪ無い場合は、そのまま終了します。
・印刷する場合
このままの状態でも「車庫図面」でページを設定して印刷すれば済むことですが、
何ページを印刷すれば良いか分かるようにしましょう。
ページ番号を取得する方法
少し長くて複雑ですが下記に記載します。
Dim Lastpage As Long, Lastpage2 As Long, p As Integer, pp As Integer
Dim LastR As Long, LastC As Integer, i As Integer, j As Integer
Dim Nrow As Long, NLrow As Long, Ncol As Integer, NLcol As Integer
Dim Crow As Long, Ccol As Integer
Dim page As Integer 'ページ番号の変数
Application.ScreenUpdating = False '画面の動きを固定
Crow = Selection.Row '選択セルの行番号
Ccol = Selection.Column '選択セルの列番号
'正しく改ページ位置を取得する為、一旦改ページプレビューにする
ActiveWindow.View = xlPageBreakPreview
'縦方向最終改ページ数取得
Lastpage = ActiveSheet.HPageBreaks.Count
'横方向最終改ページ数取得
Lastpage2 = ActiveSheet.VPageBreaks.Count
'入力済み最終行、最終列取得
With ActiveSheet.UsedRange
LastR = .Row + .Rows.Count - 1
LastC = .Column + .Columns.Count - 1
End With
Ncol = 1
p = 0 'ページ数カウント初期値
'横方向改ページ分繰り返し
For j = 1 To Lastpage2 + 1
If j = Lastpage2 + 1 Then
If Ncol > LastC Then Exit For
NLcol = LastC
Else
NLcol = ActiveSheet.VPageBreaks(j).Location.Column - 1
End If
Nrow = 1
'縦方向改ページ分繰り返し
For i = 1 To Lastpage + 1
If i = Lastpage + 1 Then
If Nrow > LastR Then Exit For
NLrow = LastR
Else
NLrow = ActiveSheet.HPageBreaks(i).Location.Row - 1
End If
p = p + 1 'ページ数カウント
If Crow >= Nrow And Crow <= NLrow Then
If Ccol >= Ncol And Ccol <= NLcol Then
pp = p
End If
End If
Nrow = NLrow + 1
Next
Ncol = NLcol + 1
Next
'改ページプレビュー、画面の固定を戻す
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
ActiveWindow.SelectedSheets.PrintOut pp, pp ‘必要なページを印刷する
上記に関しては詳しい説明は省きます。
ステップインで一つずつ動かしていけば、ある程度動作は分かると思います。
印刷の手前で「MsgBox "選択中のセルは、" & pp & " ページ目です"」という
記述をすれば下のようなメッセージが表示されます。
印刷をする場合は下記の記述をすれば必要なページが印刷されます。
ActiveWindow.SelectedSheets.PrintOut pp, pp
・履歴の保存
最初にメインページのA1に今日の日付を入れるようにしましょう。
A1に=today()と入力すると今日の日付が表示されます。
それから上記のように記述しました。
Sheets("発行履歴").Select
Sheets("発行履歴").Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'(履歴に１行挿入する）
Sheets("発行履歴").Range("A2").Value = Sheets("メイン").Range("A1")
Sheets("発行履歴").Range("B2").Value = Sheets("車庫証明").Range("j6")
Sheets("発行履歴").Range("c2").Value = Sheets("車庫証明").Range("f10")
Sheets("発行履歴").Range("d2").Value = Sheets("車庫証明").Range("f7")
最初は発効履歴に１行挿入しています。
その後、車庫証明のシートからコピーしているだけです。
これで下記のように発行履歴が残ってきます。
・フォームの「終了」ボタン
最初、この「終了」ボタンは、Excelの終了を考えていましたが、
途中でフォームが閉じられるので、このボタンでExcelの終了は出来ません。
ですから「フォーム」の終了に変更します。
ボタンの名称も「終了」から「閉じる」に変更しましょう。
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
記述内容は上記です。
それから、Excelを起動したときに、自動的にこのフォームが開くようにしましょう。
左の「ThisWorkbook」というところを選択して、上記のように記述してください。
そうするとエクセルを立ち上げた時に、自動的にユーザーフォームが立ち上がります。
一応メインページにフォームの呼出しボタンを設けていますので不要かと思いますが、
それ以外で利用する場合もあるかと思い紹介しておきます。
これ以外に何か検討することを考えると、例えば「部屋番号」を入力すると
「駐車場」番号が表示されるとか、「部屋番号」はコンボボックスにして、
そこから選択できるようにし、存在しない部屋番号を入力された場合はエラーが
出るようにするとか、色々考えられますね。
国内＆海外ホテル予約『トリバゴ』
【このカテゴリーの最新記事】
-
-
-
-
- no image
