販売管理ソフトを作る - フッタ部を動的に生成する

フッタ部を動的に生成する

00001 Option Explicit

00002 

00003 Private Const MARGIN As Integer = 4

00004 Private Const PADING As Currency = 2.8

00005 Private Const TEXT_PADING As Currency = 18 '21.75

00006 Private Const LINE_HIGHT As Integer = 18

00007 Private Const FONT_SIZE As Currency = 11.25

00008 Private Const FONT_NAME As String = "ＭＳ ゴシック"

00009 Private Const CAPTION_BORDER_COLOR As Long = &HFF8080

00010 Private Const CAPTION_BACK_COLOR As Long = &HFFC0C0

00011 Private Const LABEL_BORDER_COLOR As Long = &HC0C0C0

00012 Private Const LABEL_BACK_COLOR As Long = &H80000016

00013 Private Const ROW_NUM As Integer = 10

00014 

00015 Public Sub Main()

00016     Dim objForm As clsFormMain

00017     Set objForm = New clsFormMain

00018     Set objForm.Form = frmMain

00019 

00020     With frmMain

00021         .Caption = "見積入力"

00022         .Font.Name = FONT_NAME

00023         .Font.Size = FONT_SIZE

00024         .Height = 480 '適当に調整する

00025         .Width = 640 '適当に調整する

00026     End With

00027 

00028     Dim iTop As Integer: iTop = MARGIN + MARGIN

00029 

00030     'ヘッダ部 初期化

00031     Call CreateHeader(objForm, iTop)

00032 

00033     '明細部 初期化

00034     Call CreateDetail(objForm, iTop)

00035 

00036     'フッタ部 初期化

00037     Call CreateFooter(objForm, iTop)

00038 

00039     '終了ボタン

00040     Set objForm.cmdExit = frmMain.Controls.Add("Forms.CommandButton.1")

00041     With objForm.cmdExit

00042         .Width = 66

00043         .Height = 21

00044         .Left = frmMain.Width - .Width - MARGIN - 5 '5 は 微調整

00045         .Top = iTop

00046         .Caption = "終了"

00047     End With

00048 

00049     frmMain.Height = objForm.cmdExit.Top + objForm.cmdExit.Height + MARGIN + 23 '23 は 微調整

00050 

00051     objForm.Show

00052 End Sub

00053 

00054 'ヘッダ部 初期化

00055 Private Sub CreateHeader(objForm As clsFormMain, ByRef iTop As Integer)

00056 

00057     'パネル

00058     Dim pnlHeader As MSForms.Label

00059     Set pnlHeader = frmMain.Controls.Add("Forms.Label.1")

00060     With pnlHeader

00061         .Left = MARGIN

00062         .Top = MARGIN

00063         .Height = 150 '適当に設定しておく

00064         .Width = frmMain.Width - MARGIN - MARGIN - 5 '5 は 微調整

00065         .BorderStyle = fmBorderStyleSingle

00066         .BorderColor = LABEL_BORDER_COLOR

00067     End With

00068 

00069     'Caption, TextBox, Label

00070     Dim txtDummy(5)  As MSForms.TextBox

00071     Dim lblDummy(5)  As MSForms.Label

00072     Const CAPTION_WIDTH As Integer = 84 '適当に調整する

00073     Dim i As Integer

00074     For i = 0 To 5

00075         '標題の背景

00076         Dim pnlDummy  As MSForms.Label

00077         Set pnlDummy = frmMain.Controls.Add("Forms.Label.1")

00078         With pnlDummy

00079             .Left = MARGIN + MARGIN

00080             .Top = iTop

00081             .Height = LINE_HIGHT

00082             .Width = CAPTION_WIDTH

00083             .BorderStyle = fmBorderStyleSingle

00084             .BorderColor = CAPTION_BORDER_COLOR

00085             .BackColor = CAPTION_BACK_COLOR

00086         End With

00087 

00088         '標題

00089         Dim capDummy  As MSForms.Label

00090         Set capDummy = frmMain.Controls.Add("Forms.Label.1")

00091         With capDummy

00092             .Left = MARGIN + MARGIN

00093             .Top = iTop + PADING

00094             .Height = FONT_SIZE

00095             .Width = CAPTION_WIDTH

00096             .BackStyle = fmBackStyleTransparent

00097             .BorderStyle = fmBorderStyleNone

00098             .TextAlign = fmTextAlignCenter

00099             .Font.Name = FONT_NAME

00100             .Font.Size = FONT_SIZE

00101             Select Case i

00102                 Case 0: .Caption = "伝票番号"

00103                 Case 1: .Caption = "日付"

00104                 Case 2: .Caption = "部署"

00105                 Case 3: .Caption = "担当者"

00106                 Case 4: .Caption = "得意先"

00107                 Case 5: .Caption = "摘要"

00108             End Select

00109         End With

00110 

00111         'TextBox

00112         Set txtDummy(i) = frmMain.Controls.Add("Forms.TextBox.1")

00113         With txtDummy(i)

00114             .Left = MARGIN + MARGIN + CAPTION_WIDTH + MARGIN

00115             .Top = iTop

00116             Select Case i

00117                 Case 0: .MaxLength = 8  '伝票番号

00118                 Case 1: .MaxLength = 10 '日付

00119                 Case 2: .MaxLength = 4  '部署

00120                 Case 3: .MaxLength = 2  '担当者

00121                 Case 4: .MaxLength = 4  '得意先

00122                 Case 5: .MaxLength = 0  '摘要

00123             End Select

00124             If i = 5 Then

00125                 .Width = 400 '適当に調整する

00126             Else

00127                 '.Width = .MaxLength * (FONT_SIZE / 2) + TEXT_PADING

00128                 .Width = .MaxLength * 6 + TEXT_PADING

00129                 Debug.Print CStr(.MaxLength) & " " & CStr(.Width)

00130             End If

00131             .Height = LINE_HIGHT

00132             .Font.Name = FONT_NAME

00133             .Font.Size = FONT_SIZE

00134             If i = 5 Then

00135                 .Text = "ＮＮＮＮＮＮＮＮＮＮＮＮＮＮＮＮＮＮＮＮ"

00136             Else

00137                 .Text = String(.MaxLength, "9")

00138             End If

00139         End With

00140 

00141         Select Case i

00142             Case 2, 3, 4 '部署, 担当者, 得意先

00143             'ラベルの背景

00144             Dim pnlDummy2 As MSForms.Label

00145             Set pnlDummy2 = frmMain.Controls.Add("Forms.Label.1")

00146             With pnlDummy2

00147                 '.Left = MARGIN + MARGIN + CAPTION_WIDTH + MARGIN + (4 * (FONT_SIZE / 2) + TEXT_PADING) + MARGIN

00148                 .Left = MARGIN + MARGIN + CAPTION_WIDTH + MARGIN + (4 * 6 + TEXT_PADING) + MARGIN

00149                 .Top = iTop

00150                 .Width = 350 '適当に調整する

00151                 .Height = LINE_HIGHT

00152                 .BorderStyle = fmBorderStyleSingle

00153                 .BorderColor = LABEL_BORDER_COLOR

00154                 .BackColor = LABEL_BACK_COLOR

00155             End With

00156 

00157             'ラベル

00158             Set lblDummy(i) = frmMain.Controls.Add("Forms.Label.1")

00159             With lblDummy(i)

00160                 .Left = MARGIN + MARGIN + CAPTION_WIDTH + MARGIN + (4 * (FONT_SIZE / 2) + TEXT_PADING) + MARGIN + PADING

00161                 .Top = iTop + PADING

00162                 .Width = 350 - (PADING * 2) '適当に調整する

00163                 .BorderStyle = fmBorderStyleNone

00164                 .BackStyle = fmBackStyleTransparent

00165                 .Font.Name = FONT_NAME

00166                 .Font.Size = FONT_SIZE

00167                 .Caption = "ＮＮＮＮＮＮＮＮＮＮ"

00168             End With

00169         End Select

00170 

00171         iTop = iTop + LINE_HIGHT + MARGIN

00172     Next

00173 

00174     'パネル高さ 調整

00175     pnlHeader.Height = iTop - pnlHeader.Top

00176 

00177     '伝票番号

00178     Set objForm.txtDenpyoNo = txtDummy(0)

00179 

00180 End Sub

00181 

00182 '明細部 初期化

00183 Private Sub CreateDetail(objForm As clsFormMain, ByRef iTop As Integer)

00184 

00185     'パネル

00186     Dim pnlDetail As MSForms.Label

00187     Set pnlDetail = frmMain.Controls.Add("Forms.Label.1")

00188     With pnlDetail

00189         .Left = MARGIN

00190         .Top = iTop + MARGIN

00191         .Height = 150 '適当に設定しておく

00192         .Width = frmMain.Width - MARGIN - MARGIN - 5 '5 は 微調整

00193         .BorderStyle = fmBorderStyleSingle

00194         .BorderColor = LABEL_BORDER_COLOR

00195     End With

00196     iTop = iTop + MARGIN + MARGIN

00197 

00198     Dim iCol As Integer

00199     Dim iRow As Integer

00200     Dim iLeft As Integer

00201 

00202     iLeft = MARGIN + MARGIN

00203     For iCol = 0 To 7

00204 

00205         '標題の背景

00206         Dim pnlDummy As MSForms.Label

00207         Set pnlDummy = frmMain.Controls.Add("Forms.Label.1")

00208         With pnlDummy

00209             .Left = iLeft

00210             .Top = iTop

00211             .Height = LINE_HIGHT

00212 

00213             Select Case iCol

00214                 Case 0: .Width = 3 * 6 + PADING * 2 'No.

00215                 Case 1: .Width = 8 * 6 + TEXT_PADING  '商品CD

00216                 Case 2: .Width = 21 * 6 + PADING * 2  '商品名

00217                 Case 3: .Width = 5 * 6 + PADING * 2  '単位

00218                 Case 4: .Width = 8 * 6 + PADING * 2  '単価

00219                 Case 5: .Width = 5 * 6 + PADING * 2  '数量

00220                 Case 6: .Width = 8 * 6 + PADING * 2  '金額

00221                 Case 7: .Width = 25 * 6 + TEXT_PADING '備考

00222             End Select

00223 

00224             .BorderStyle = fmBorderStyleSingle

00225             .BorderColor = CAPTION_BORDER_COLOR

00226             .BackColor = CAPTION_BACK_COLOR

00227         End With

00228 

00229 

00230         '標題

00231         Dim capDummy As MSForms.Label

00232         Set capDummy = frmMain.Controls.Add("Forms.Label.1")

00233         With capDummy

00234             .Left = iLeft

00235             .Top = iTop + PADING

00236             .Height = FONT_SIZE

00237             .Width = pnlDummy.Width

00238             .BackStyle = fmBackStyleTransparent

00239             .BorderStyle = fmBorderStyleNone

00240             .TextAlign = fmTextAlignCenter

00241 

00242             Select Case iCol

00243                 Case 0: .Caption = "No"

00244                 Case 1: .Caption = "商品CD"

00245                 Case 2: .Caption = "商品名"

00246                 Case 3: .Caption = "単位"

00247                 Case 4: .Caption = "単価"

00248                 Case 5: .Caption = "数量"

00249                 Case 6: .Caption = "金額"

00250                 Case 7: .Caption = "備考"

00251             End Select

00252         End With

00253 

00254         For iRow = 1 To ROW_NUM

00255             Select Case iCol

00256                 Case 0, 2, 3, 6 'No, 商品名, 単位, 金額

00257                 'ラベルの背景

00258                 Dim pnlDummy2 As MSForms.Label

00259                 Set pnlDummy2 = frmMain.Controls.Add("Forms.Label.1")

00260                 With pnlDummy2

00261                     .Left = iLeft

00262                     .Top = iTop + (LINE_HIGHT + MARGIN) * iRow

00263                     .Height = LINE_HIGHT

00264                     .Width = pnlDummy.Width

00265                     .BorderStyle = fmBorderStyleSingle

00266                     .BorderColor = LABEL_BORDER_COLOR

00267                     .BackColor = LABEL_BACK_COLOR

00268                 End With

00269                 'ラベル

00270                 Dim lblDummy As MSForms.Label

00271                 Set lblDummy = frmMain.Controls.Add("Forms.Label.1")

00272                 With lblDummy

00273                     .Left = iLeft + PADING

00274                     .Top = iTop + (LINE_HIGHT + MARGIN) * iRow + PADING

00275                     .Height = FONT_SIZE

00276                     .Width = pnlDummy.Width - (PADING * 2)

00277                     .BackStyle = fmBackStyleTransparent

00278                     .BorderStyle = fmBorderStyleNone

00279                     Select Case iCol

00280                         Case 0: .TextAlign = fmTextAlignCenter 'No.

00281                         Case 2: .TextAlign = fmTextAlignLeft '商品名

00282                         Case 3: .TextAlign = fmTextAlignCenter '単位

00283                         Case 6: .TextAlign = fmTextAlignRight '金額

00284                     End Select

00285 

00286                     Select Case iCol

00287                         Case 0: .Caption = "99" 'No.

00288                         Case 2: .Caption = "１２３４５６７８９０" '商品名

00289                         Case 3: .Caption = "１２" '単位

00290                         Case 6: .Caption = "99,999" '金額

00291                     End Select

00292                 End With

00293 

00294                 Case 1, 4, 5, 7 '商品CD, 単価, 数量, 備考

00295                     'TextBox

00296                     Dim txtDummy As MSForms.TextBox

00297                     Set txtDummy = frmMain.Controls.Add("Forms.TextBox.1")

00298                     With txtDummy

00299                         .Left = iLeft

00300                         .Top = iTop + (LINE_HIGHT + MARGIN) * iRow

00301                         .Width = pnlDummy.Width

00302                         .Height = LINE_HIGHT

00303                         .Font.Name = FONT_NAME

00304                         .Font.Size = FONT_SIZE

00305                         Select Case iCol

00306                             Case 1: .TextAlign = fmTextAlignLeft '商品CD

00307                             Case 4: .TextAlign = fmTextAlignRight '単価

00308                             Case 5: .TextAlign = fmTextAlignRight '数量

00309                             Case 7: .TextAlign = fmTextAlignLeft '備考

00310                         End Select

00311                         Select Case iCol

00312                             Case 1: .Text = "12345678" '商品CD

00313                             Case 4: .Text = "99,999" '単価

00314                             Case 5: .Text = "999" '数量

00315                             Case 7: .Text = "１２３４５６７８９０" '備考

00316                         End Select

00317                     End With

00318 

00319             End Select

00320         Next

00321 

00322         iLeft = iLeft + pnlDummy.Width + MARGIN

00323     Next

00324 

00325     'パネル高さ 調整

00326     pnlDetail.Height = (iTop + (LINE_HIGHT + MARGIN) * (ROW_NUM + 1)) - pnlDetail.Top

00327     iTop = pnlDetail.Top + pnlDetail.Height

00328 

00329     'スクロールバー

00330     Dim vsbDummy As MSForms.ScrollBar

00331     Set vsbDummy = frmMain.Controls.Add("Forms.ScrollBar.1")

00332     With vsbDummy

00333         .Width = 15

00334         .Left = pnlDetail.Left + pnlDetail.Width - .Width - MARGIN

00335         .Top = pnlDetail.Top + MARGIN

00336         .Height = pnlDetail.Height - MARGIN - MARGIN

00337         .Min = 0

00338         .Max = 0

00339         .Value = 0

00340         .TabStop = False

00341     End With

00342 End Sub

00343 

00344 'フッタ部 初期化

00345 Private Sub CreateFooter(objForm As clsFormMain, ByRef iTop As Integer)

00346 

00347     'パネル

00348     Dim pnlDetail As MSForms.Label

00349     Set pnlDetail = frmMain.Controls.Add("Forms.Label.1")

00350     With pnlDetail

00351         .Left = MARGIN

00352         .Top = iTop + MARGIN

00353         .Height = LINE_HIGHT + MARGIN + MARGIN

00354         .Width = frmMain.Width - MARGIN - MARGIN - 5 '5 は 微調整

00355         .BorderStyle = fmBorderStyleSingle

00356         .BorderColor = LABEL_BORDER_COLOR

00357     End With

00358     iTop = iTop + MARGIN + MARGIN

00359 

00360     Dim iCol As Integer

00361     Dim iLeft As Integer

00362     Dim iWidth As Integer: iWidth = 8 * 6 + PADING * 2

00363     For iCol = 1 To 3

00364         '標題の背景

00365         Dim pnlDummy As MSForms.Label

00366         Set pnlDummy = frmMain.Controls.Add("Forms.Label.1")

00367         With pnlDummy

00368             .Left = pnlDetail.Left + pnlDetail.Width - ((iWidth + MARGIN) * 2 * iCol)

00369             .Top = iTop

00370             .Height = LINE_HIGHT

00371             .Width = iWidth

00372             .BorderStyle = fmBorderStyleSingle

00373             .BorderColor = CAPTION_BORDER_COLOR

00374             .BackColor = CAPTION_BACK_COLOR

00375         End With

00376 

00377         '標題

00378         Dim capDummy As MSForms.Label

00379         Set capDummy = frmMain.Controls.Add("Forms.Label.1")

00380         With capDummy

00381             .Left = pnlDummy.Left

00382             .Top = iTop + PADING

00383             .Height = FONT_SIZE

00384             .Width = pnlDummy.Width

00385             .BackStyle = fmBackStyleTransparent

00386             .BorderStyle = fmBorderStyleNone

00387             .TextAlign = fmTextAlignCenter

00388 

00389             Select Case iCol

00390                 Case 1: .Caption = "金額計"

00391                 Case 2: .Caption = "消費税"

00392                 Case 3: .Caption = "合計"

00393             End Select

00394         End With

00395 

00396         'ラベルの背景

00397         Dim pnlDummy2 As MSForms.Label

00398         Set pnlDummy2 = frmMain.Controls.Add("Forms.Label.1")

00399         With pnlDummy2

00400             .Left = pnlDetail.Left + pnlDetail.Width - ((iWidth + MARGIN) * 2 * iCol) + iWidth + MARGIN

00401             .Top = iTop

00402             .Height = LINE_HIGHT

00403             .Width = iWidth

00404             .BorderStyle = fmBorderStyleSingle

00405             .BorderColor = LABEL_BORDER_COLOR

00406             .BackColor = LABEL_BACK_COLOR

00407         End With

00408 

00409         'ラベル

00410         Dim lblDummy As MSForms.Label

00411         Set lblDummy = frmMain.Controls.Add("Forms.Label.1")

00412         With lblDummy

00413             .Left = pnlDummy2.Left + PADING

00414             .Top = iTop + PADING

00415             .Height = FONT_SIZE

00416             .Width = pnlDummy2.Width - PADING - PADING

00417             .BackStyle = fmBackStyleTransparent

00418             .BorderStyle = fmBorderStyleNone

00419             .TextAlign = fmTextAlignRight

00420             .Caption = "999,999"

00421         End With

00422     Next

00423 

00424     iTop = iTop + pnlDetail.Height

00425 End Sub

00426