住所録からタックシール用のラベル用紙に印刷させるサンプルです。
ラベル用紙は縦横の枚数やピッチ、1ラベル内の項目配置を「設定」シートでコントロールできるので汎用的に利用できるかも知れません。
- 少しはVBAならでは、と言えるサンプルも作ってみましょう。
- 住所録である「DATA」、実際に印刷イメージを作成する「LABEL」、設定情報を収容する「設定」の3シートで構成するワークブックです。
ラベルシートの配置ではシートの横方向も数値インデックスで扱うので、行列番号を「R1C1参照形式」で利用します。
■住所録である「DATA」シート
(この画像をクリックすると、このページのサンプルがダウンロードができます。)
■実際に印刷イメージを作成する「LABEL」シート
■設定情報(配置パラメータ)を収容する「設定」シート
この設定情報によって、ラベルの縦横の枚数やピッチ、1ラベル内の表示させる項目の配置をコントロールできるようになっています。
実際のラベル用紙は各社から多数発売されていて、用紙サイズや枚数、ピッチなどはさまざまです。この設定情報と、「LABEL」シートの余白と拡大／縮小を組み合わせて調整します。
○枚数／頁
印刷の1ページに対するラベルの枚数を横・縦に分けて設定します。 サンプルのままだと、横2件×縦3件が1ページで印刷されます。
縦1列だけなら「横」を「1」にすれば良いですし、縦横ともに「1」にすれば1ページ1件の差し込み印刷も可能です。
○ピッチ／枚
左右／上下のラベル間のピッチを列数／行数で指定します。この指定と、実際の「LABEL」シートの行の高さ、列の幅、さらには印刷時の倍率を駆使して、使うラベル用紙に合うように調整して下さい。
なお、ページ全体のピッチはこれらの指定に加えて「余白」で調整する必要があります。
○項目配置
ラベル内の配置する各項目の左端位置を、そのラベルの左上起点で指定します。不要な項目はブランク(「横」がゼロと判断される)として下さい。
起点セルを「1」としているので、起点セルの右隣(又は直下)のセルであれば値は「2」となります。
- サンプルで処理(実行)すると．．．．
- サンプルマクロの起動は、ボタン等は用意していません。「マクロ」から「PrintLabels」を起動させて下さい。
近年の通常のPCであれば処理は一瞬程度で終了し「LABEL」シートがアクティブになって表示されます。
また、直接印刷はされません。印刷用の「LABEL」シートに値転記されるだけです。
処理結果は、
こんな感じです。
実際の宛名ラベルへの印刷は実行していませんので、もし流用されるのであれば「設定」シートの値だけでなく、「LABEL」シートの文字サイズ・行の高さ・列幅・印刷倍率等を 調整して実現状態を確認して下さい。
- では、「モジュール構成図」を考えてみましょう。
- 「モジュール構成図」は、多段集計と似ていて、全体レベル、ページ内縦方向のレベル、横方向のレベルの3階層になります。
各モジュールの説明は以下の通りです。
(1)全体制御 ①「(2)全体前処理」を行なう。
②「(3)全体主処理」を「DATA」から取得したテーブルの全件について繰り返して行なう。
③「(4)全体後処理」を行なう。(2)全体前処理 ①「設定」シートの内容チェックを行ない、設定情報を取得する。
②「DATA」シートのデータ存在チェックを行ない、有効内容(「除外」を除く)をテーブルに取得する。
③画面描画を停止する。
④「LABEL」シート全体をクリアする。
※①、②は実際のソースコード上ではサブプロシージャを作成して呼び出しています。(3)全体主処理 ※1ページ単位(縦m件×横n件)の処理です。
①「(5)縦方向前処理」を行なう。
②「(6)縦方向主処理」を縦方向のカウント数分繰り返して行なう。(4)全体後処理 ①「LABEL」シートを表示する。
②画面描画を再開する。(5)縦方向前処理 ①2ページ目以降は改ページをセットする。
②縦方向カウントをゼロに戻す。(6)縦方向主処理 ※1ページ内の縦方向1行分の処理です。
①「(7)横方向前処理」を行なう。
②「(8)横方向主処理」を横方向カウント数分行なう。
③「(9)横方向後処理」を行なう。(7)横方向前処理 ①横方向カウントをゼロに戻す。
②ラベル左端位置カラムを1に戻す。
※単純処理なので実際のソースコード上ではプロシージャとして作成していません。(8)横方向主処理 ※横方向1件、つまり宛先1件分の処理です。
①「設定」シートから取得した各位置情報(10項目)に従って「LABEL」シートに各項目をセットする。
②ラベル左端位置カラムに横ピッチを加算する。
③「DATA」シートから取得したテーブルのINDEXを加算する。
④最終行到達後は、縦横の方向カウンタに最大値をセットしてブレークさせる。(9)横方向後処理 ①ラベル上端位置行に縦ピッチを加算する。
②縦方向カウントを加算する。
※単純処理なので実際のソースコード上ではプロシージャとして作成していません。
- では、これに従ってソースコードを作成してみましょう。
- ソースコードは、こんな感じになりました。
基本的には「モジュール構成図」に従ってプロシージャ分けを行なっていますが、一部省略や複雑な部分をサブプロシージャ分けしたりしていますが、 該当については上の「モジュール構成図」の説明にも記載しています。
また、以前のページでは各プロシージャ間で受け渡される変数について、プロシージャの構成(「モジュール構成図」のモジュール)を明確にするため、 引数とはせずに全てモジュールレベル変数で処理していましたが、今回はモジュールレベル変数は処理の途中で変動がないものだけにして、 行列やテーブルインデックス等の変動要素は全てプロシージャ側の引数で扱っています。
初心者の方には「いきなりハードルが上がった」ように見えるかも知れませんが、 実務としてのマクロ作成であればこのページの方法の方がより良いもので、設計に従った機能分割と変数配置によるプロシージャの作成として学んでいただきたいと思います。
各プロシージャの受け渡しの引数は全て「値渡し(ByVal)」か「参照渡し(ByRef)」を明示しています。
「値渡し(ByVal)」「参照渡し(ByRef)」については「値の渡し方」を参照して下さい。
'*************************************************************************************************** ' ラベル発行のサンプル Module1(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '04/02/20(1.00)新規作成 '16/11/19(1.10)*.xlsm化の変更 '20/02/18(1.20)コード整理、標準化準拠作業 '*************************************************************************************************** Option Explicit '=================================================================================================== Private Const g_cnsTitle As String = "ラベル発行のサンプル" Private Const g_cnsSH1 As String = "DATA" Private Const g_cnsSH2 As String = "LABEL" Private Const g_cnsSH3 As String = "設定" Private Const g_cnsOMIT As String = "除外" '--------------------------------------------------------------------------------------------------- ' 各項目の配置定義用ユーザー定義 Private Type g_typLocation X As Long ' カラム増分 Y As Long ' 行増分 Col As Long ' DATA上のカラム End Type ' DATA各項目用ユーザー定義 Private Type g_typData KaisyaNm As String ' 会社名 BusyoNm As String ' 部署名 YakuNm As String ' 役職名 Shimei As String ' 氏名 Yubin As String ' 〒 Jusyo1 As String ' 住所① Jusyo2 As String ' 住所② Tel As String ' 電話番号 Fax As String ' FAX番号 EMail As String ' Eメール End Type '--------------------------------------------------------------------------------------------------- ' ブックやシートのオブジェクト Private g_objWbk As Workbook ' 本ブック Private g_objSh1 As Worksheet ' DATAシート Private g_objSh2 As Worksheet ' LABELシート Private g_objSh3 As Worksheet ' 設定シート ' 設定情報(配置パラメータ) Private g_lngParamCntX As Long ' 横面付 Private g_lngParamCntY As Long ' 縦面付 Private g_lngParamRow As Long ' 行ピッチ Private g_lngParamCol As Long ' 縦ピッチ Private g_tblLoc(9) As g_typLocation ' 項目配置定義(ユーザー定義配列) ' DATA内容テーブル(有効内容のみ) Private g_tblData() As g_typData ' DATA内容テーブル Private g_lngIxMaxData As Long ' DATA内容テーブル最大要素INDEX '*************************************************************************************************** ' ■■■ シート側からの起動処理 ■■■ '*************************************************************************************************** '* 処理名 ：PrintLabels '* 機能 ：ラベル発行(メイン) '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明：モジュール構成図の｢(1)全体制御｣です。 '* 注意事項： '*************************************************************************************************** Public Sub PrintLabels() '----------------------------------------------------------------------------------------------- Dim lngIxData As Long ' DATA現在INDEX Dim lngRowL As Long ' LABEL行(全体) Dim lngCntPG As Long ' ページカウンタ ' (2)全体前処理 If FP_AllInitProc Then ' 引き渡し変数初期化 lngIxData = 0 ' DATA現在INDEX lngRowL = 1 ' LABEL先頭行 lngCntPG = 0 ' ページカウンタ ' ※全体主処理(全体ループ) Do While lngIxData <= g_lngIxMaxData ' (3)全体主処理 Call GP_AllMainProc(lngIxData, lngRowL, lngCntPG) Loop ' LABELシートをActiveにする g_objSh2.Activate End If ' (4)全体後処理 Call GP_AllFinalProc End Sub '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：FP_AllInitProc '* 機能 ：(2)全体前処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_AllInitProc() As Boolean '----------------------------------------------------------------------------------------------- FP_AllInitProc = False ' 各Object変数のセット Set g_objWbk = ThisWorkbook Set g_objSh1 = g_objWbk.Worksheets(g_cnsSH1) ' DATA Set g_objSh2 = g_objWbk.Worksheets(g_cnsSH2) ' LABEL Set g_objSh3 = g_objWbk.Worksheets(g_cnsSH3) ' 設定 ' 設定値のチェック＋取得 If Not FP_GetParam Then Exit Function ' DATA内容のチェック＋取得 If Not FP_GetData Then Exit Function ' 画面描画停止 With Application .ScreenUpdating = False ' 画面描画停止 .EnableEvents = False ' イベント停止 .Calculation = xlCalculationManual ' 自動計算停止 .Cursor = xlWait ' マウスカーソル砂時計 End With ' LABELシートのクリア g_objSh2.Cells.ClearContents FP_AllInitProc = True End Function '*************************************************************************************************** '* 処理名 ：GP_AllMainProc '* 機能 ：(3)全体主処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = DATA現在INDEX(Long) ※Ref参照 '* Arg2 = LABEL現在行(Long) ※Ref参照 '* Arg3 = ページカウンタ(Long) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明：1ページ単位(縦m件×横n件)の処理です。 '* 注意事項： '*************************************************************************************************** Private Sub GP_AllMainProc(ByRef lngIxData As Long, _ ByRef lngRowL As Long, _ ByRef lngCntPG As Long) '----------------------------------------------------------------------------------------------- Dim lngCntY As Long ' 縦カウンタ ' (5)縦方向前処理 Call GP_RowInitProc(lngCntY, lngCntPG, lngRowL) ' 縦方向ループ Do While lngCntY < g_lngParamCntY ' (6)縦方向主処理 Call GP_RowMainProc(lngIxData, lngRowL, lngCntY) ' 縦方向カウンタ加算 lngCntY = lngCntY + 1 Loop End Sub '*************************************************************************************************** '* 処理名 ：GP_AllFinalProc '* 機能 ：(4)全体後処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_AllFinalProc() '----------------------------------------------------------------------------------------------- ' 画面描画再開 With Application .StatusBar = False ' StatusBar解除 .EnableEvents = True ' イベント停止解除 .Calculation = xlCalculationAutomatic ' 自動計算設定 .Cursor = xlDefault ' マウスカーソル矢印 .ScreenUpdating = True ' 画面描画再開 End With ' 保存済みにする g_objWbk.Saved = True End Sub '*************************************************************************************************** '* 処理名 ：GP_RowInitProc '* 機能 ：(5)縦方向前処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 縦方向カウンタ(Long) ※Ref参照 '* Arg2 = ページカウンタ(Long) ※Ref参照 '* Arg3 = LABEL現在行(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_RowInitProc(ByRef lngCntY As Long, _ ByRef lngCntPG As Long, _ ByVal lngRowL As Long) '----------------------------------------------------------------------------------------------- ' 2頁目以降は改頁挿入 If lngCntPG > 0 Then g_objSh2.HPageBreaks.Add Before:=g_objSh2.Cells(lngRowL, 1) End If ' ページカウンタ加算 lngCntPG = lngCntPG + 1 ' 縦方向カウンタクリア lngCntY = 0 End Sub '*************************************************************************************************** '* 処理名 ：GP_RowMainProc '* 機能 ：(6)縦方向主処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = DATA現在INDEX(Long) ※Ref参照 '* Arg2 = LABEL現在行(Long) ※Ref参照 '* Arg3 = 縦方向カウンタ(Long) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_RowMainProc(ByRef lngIxData As Long, _ ByRef lngRowL As Long, _ ByRef lngCntY As Long) '----------------------------------------------------------------------------------------------- Dim lngCntX As Long ' 横カウンタ Dim lngColL As Long ' LABEL現在カラム(全体) ' (7)横方向前処理 lngCntX = 0 lngColL = 1 ' 横方向ループ Do While lngCntX < g_lngParamCntX ' (8)横方向主処理 Call GP_ColMainProc(lngIxData, lngRowL, lngColL, lngCntY, lngCntX) ' 横方向カウンタ加算 lngCntX = lngCntX + 1 Loop ' (9)横方向後処理 lngRowL = lngRowL + g_lngParamRow ' LABEL現在行を加算 End Sub '*************************************************************************************************** '* 処理名 ：GP_ColMainProc '* 機能 ：(8)横方向主処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = DATA現在INDEX(Long) ※Ref参照 '* Arg2 = LABEL現在行(Long) '* Arg3 = LABEL現在カラム(Long) ※Ref参照 '* Arg4 = 縦方向カウンタ(Long) ※Ref参照 '* Arg5 = 横方向カウンタ(Long) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_ColMainProc(ByRef lngIxData As Long, _ ByVal lngRowL As Long, _ ByRef lngColL As Long, _ ByRef lngCntY As Long, _ ByRef lngCntX As Long) '----------------------------------------------------------------------------------------------- Dim lngIx As Long ' INDEX(テーブル) ' ラベル上の各項目位置の算出しセット For lngIx = 0 To 9 ' 1項目分のセット Call GP_SetData(lngIxData, lngRowL, lngColL, lngIx) Next lngIx ' 次のDATAへ lngColL = lngColL + g_lngParamCol lngIxData = lngIxData + 1 ' 最終DATA判定 If lngIxData > g_lngIxMaxData Then ' EOF判定時は縦横ともブレークさせる lngCntX = g_lngParamCntX lngCntY = g_lngParamCntY End If End Sub '*************************************************************************************************** ' ■■■ モジュール構成図不記載のサブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：GP_SetData '* 機能 ：1項目分のセット '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = DATA現在INDEX(Long) '* Arg2 = LABEL現在行(Long) '* Arg3 = LABEL現在カラム(Long) '* Arg4 = 項目INDEX(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Sub GP_SetData(ByVal lngIxData As Long, _ ByVal lngRowL As Long, _ ByVal lngColL As Long, _ ByVal lngIx As Long) '----------------------------------------------------------------------------------------------- Dim lngRow As Long ' 行WORK Dim lngCol As Long ' カラムWORK With g_tblData(lngIxData) ' 横方向、縦方向が有効か If ((g_tblLoc(lngIx).X >= 0) And (g_tblLoc(lngIx).Y >= 0)) Then lngCol = lngColL + g_tblLoc(lngIx).X ' LABEL上のカラム lngRow = lngRowL + g_tblLoc(lngIx).Y ' LABEL上の行 ' 項目を判定 Select Case lngIx Case 0 ' 会社名 g_objSh2.Cells(lngRow, lngCol).Value = .KaisyaNm Case 1 ' 部署名 g_objSh2.Cells(lngRow, lngCol).Value = .BusyoNm Case 2 ' 役職名 g_objSh2.Cells(lngRow, lngCol).Value = .YakuNm Case 3 ' 氏名 g_objSh2.Cells(lngRow, lngCol).Value = .Shimei & " 様" Case 4 ' 〒 g_objSh2.Cells(lngRow, lngCol).Value = "〒" & .Yubin Case 5 ' 住所① g_objSh2.Cells(lngRow, lngCol).Value = .Jusyo1 Case 6 ' 住所② g_objSh2.Cells(lngRow, lngCol).Value = .Jusyo2 Case 7 ' 電話番号 g_objSh2.Cells(lngRow, lngCol).Value = .Tel Case 8 ' FAX番号 g_objSh2.Cells(lngRow, lngCol).Value = .Fax Case 9 ' Eメール g_objSh2.Cells(lngRow, lngCol).Value = .EMail End Select End If End With End Sub '*************************************************************************************************** '* 処理名 ：FP_GetParam '* 機能 ：設定値のチェック＋取得 '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明：この処理は｢(2)全体前処理｣の一部です。 '* 注意事項： '*************************************************************************************************** Private Function FP_GetParam() As Boolean '----------------------------------------------------------------------------------------------- Dim lngRow As Long ' 行WORK Dim lngCol As Long ' カラムWORK Dim lngIx As Long ' INDEX(テーブル) Dim strErrMSG As String ' エラーメッセージ FP_GetParam = False '----------------------------------------------------------------------------------------------- ' 設定値の条理チェック With g_objSh3 ' 有効設定があるか If ((.Cells(3, 3).Value < 1) Or _ (.Cells(3, 3).Value > 10) Or _ (.Cells(3, 4).Value < 1) Or _ (.Cells(3, 4).Value > 20)) Then Call GP_AppendMessage("枚数が設定されていません。", strErrMSG) ElseIf ((.Cells(6, 3).Value < 10) Or _ (.Cells(6, 3).Value > 200) Or _ (.Cells(6, 4).Value < 5) Or _ (.Cells(6, 4).Value > 50)) Then Call GP_AppendMessage("ピッチが設定されていません。", strErrMSG) End If ' 項目配置テーブル For lngRow = 10 To 19 ' 有効行か If ((.Cells(lngRow, 3).Value > 0) And _ (.Cells(lngRow, 4).Value > 0)) Then If .Cells(lngRow, 3).Value >= .Cells(6, 3).Value Then Call GP_AppendMessage(.Cells(lngRow, 2).Value & "が横ピッチオーバーです。", strErrMSG) ElseIf .Cells(lngRow, 4).Value >= .Cells(6, 4).Value Then Call GP_AppendMessage(.Cells(lngRow, 2).Value & "が縦ピッチオーバーです。", strErrMSG) End If ElseIf ((.Cells(lngRow, 3).Value > 0) Or _ (.Cells(lngRow, 4).Value > 0)) Then Call GP_AppendMessage(.Cells(lngRow, 2).Value & "が横縦の配置不揃いです。", strErrMSG) End If Next lngRow End With ' エラーがあれば終了 If strErrMSG <> "" Then MsgBox strErrMSG, vbExclamation, g_cnsTitle Exit Function End If '----------------------------------------------------------------------------------------------- ' 設定値取得 With g_objSh3 g_lngParamCntX = .Cells(3, 3).Value ' 横面付 g_lngParamCntY = .Cells(3, 4).Value ' 縦面付 g_lngParamRow = .Cells(6, 4).Value ' 横ピッチ g_lngParamCol = .Cells(6, 3).Value ' 縦ピッチ lngCol = 1 lngRow = 9 ' ラベル1件内各項目の配置(10項目固定) For lngIx = 0 To 9 lngCol = lngCol + 1 lngRow = lngRow + 1 ' 項目配置は｢増分｣に変換 g_tblLoc(lngIx).X = .Cells(lngRow, 3).Value - 1 ' カラム増分 g_tblLoc(lngIx).Y = .Cells(lngRow, 4).Value - 1 ' 行増分 g_tblLoc(lngIx).Col = lngCol ' DATA上のカラム Next lngIx End With FP_GetParam = True End Function '*************************************************************************************************** '* 処理名 ：FP_GetData '* 機能 ：DATA内容のチェック＋取得 '--------------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2004年02月20日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明：この処理は｢(2)全体前処理｣の一部です。 '* 注意事項： '*************************************************************************************************** Private Function FP_GetData() As Boolean '----------------------------------------------------------------------------------------------- Dim lngRow As Long ' 行WORK Dim lngRowMax As Long ' DATA最大行 Dim lngCnt As Long ' カウンタWORK Dim lngIx As Long ' INDEX(テーブル) Dim strErrMSG As String ' エラーメッセージ FP_GetData = False ' DATA件数確認 With g_objSh1 lngRowMax = .Cells.SpecialCells(xlCellTypeLastCell).Row lngCnt = 0 lngRow = 2 lngIx = -1 ReDim g_tblData(0) ' DATAの各行を巡回 Do While lngRow <= lngRowMax ' 有効内容か("除外"でないこと) If .Cells(lngRow, 1).Value <> g_cnsOMIT Then lngCnt = lngCnt + 1 lngIx = lngIx + 1 ReDim Preserve g_tblData(lngIx) ' 各項目をテーブル側に転記 g_tblData(lngIx).KaisyaNm = Trim(.Cells(lngRow, 2).Value) ' 会社名 g_tblData(lngIx).BusyoNm = Trim(.Cells(lngRow, 3).Value) ' 部署名 g_tblData(lngIx).YakuNm = Trim(.Cells(lngRow, 4).Value) ' 役職名 g_tblData(lngIx).Shimei = Trim(.Cells(lngRow, 5).Value) ' 氏名 g_tblData(lngIx).Yubin = Trim(.Cells(lngRow, 6).Value) ' 〒 g_tblData(lngIx).Jusyo1 = Trim(.Cells(lngRow, 7).Value) ' 住所① g_tblData(lngIx).Jusyo2 = Trim(.Cells(lngRow, 8).Value) ' 住所② g_tblData(lngIx).Tel = Trim(.Cells(lngRow, 9).Value) ' 電話番号 g_tblData(lngIx).Fax = Trim(.Cells(lngRow, 10).Value) ' FAX番号 g_tblData(lngIx).EMail = Trim(.Cells(lngRow, 11).Value) ' Eメール End If ' 次の行へ lngRow = lngRow + 1 Loop ' 有効データがなければ終了 If lngCnt < 1 Then MsgBox "ラベル発行用有効データがありません。", vbExclamation, g_cnsTitle Exit Function End If End With g_lngIxMaxData = lngIx FP_GetData = True End Function '*************************************************************************************************** '* 処理名 ：GP_AppendMessage '* 機能 ：エラーメッセージ累積 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 今回メッセージ(String) '* Arg2 = 累積メッセージ(String) ※Ref参照 '--------------------------------------------------------------------------------------------------- '* 作成日 ：2020年02月18日 '* 作成者 ：井上 治 '* 更新日 ：2020年02月18日 '* 更新者 ：井上 治 '* 機能説明：改行を付加して追加 '* 注意事項： '*************************************************************************************************** Private Sub GP_AppendMessage(ByVal strAddMSG As String, ByRef strMSG As String) '----------------------------------------------------------------------------------------------- If strMSG <> "" Then strMSG = strMSG & vbCrLf strMSG = strMSG & strAddMSG End Sub '------------------------------------------<< End of Source >>--------------------------------------
これはあくまでサンプルです。
このような要件の処理をスイスイ書くのにはかなり経験が必要です。今すぐ書くようになる必要はありませんが、前頁までの考え方が身に付けば、後は経験次第でできるようになります。
前ページまでの設計方法の理解と、個々の記述規則がある程度理解できたら、作ってみたい仕組みにチャレンジしてみて下さい。
前ページまでの設計方法の理解と、個々の記述規則がある程度理解できたら、作ってみたい仕組みにチャレンジしてみて下さい。