販売管理ソフトを作る - 「見積一覧」 検索結果表示処理

「見積一覧」 検索結果表示処理

■ frmList

00635 '一覧表示

00636 Private Sub cmdSearch_Click()

00637     If Not InputCheck(cmdSearch) Then Exit Sub

00638 

00639     '明細部 クリア

00640     ClearDetail

00641 

00642     'クエリー文字列を編集

00643     Dim Sql As String: Sql = ""

00644     Sql = Sql & "SELECT "

00645     Sql = Sql & "    A.伝票NO "

00646     Sql = Sql & ",   A.日付 "

00647     Sql = Sql & ",   A.部署CD "

00648     Sql = Sql & ",   B.部署NM "

00649     Sql = Sql & ",   A.担当者CD "

00650     Sql = Sql & ",   C.担当者NM "

00651     Sql = Sql & ",   A.得意先CD "

00652     Sql = Sql & ",   D.得意先NM "

00653     Sql = Sql & "FROM "

00654     Sql = Sql & "( "

00655     Sql = Sql & "( "

00656     Sql = Sql & "    TH_見積書 AS A "

00657     Sql = Sql & "INNER JOIN "

00658     Sql = Sql & "    TM_部署 AS B "

00659     Sql = Sql & "ON "

00660     Sql = Sql & "    B.部署CD = A.部署CD "

00661     Sql = Sql & ") "

00662     Sql = Sql & "INNER JOIN "

00663     Sql = Sql & "    TM_担当者 AS C "

00664     Sql = Sql & "ON "

00665     Sql = Sql & "        C.部署CD   = A.部署CD "

00666     Sql = Sql & "    AND C.担当者CD = A.担当者CD "

00667     Sql = Sql & ") "

00668     Sql = Sql & "INNER JOIN "

00669     Sql = Sql & "    TM_得意先 AS D "

00670     Sql = Sql & "ON "

00671     Sql = Sql & "    D.得意先CD = A.得意先CD "

00672 

00673     Sql = Sql & "WHERE 1 = 1 "

00674 

00675     If IsDate(txtDateMin.Text) Then

00676         Sql = Sql & "  AND A.日付 >= '" & txtDateMin.Text & "' "

00677     End If

00678 

00679     If IsDate(txtDateMax.Text) Then

00680         Sql = Sql & "  AND A.日付 <= '" & txtDateMax.Text & "' "

00681     End If

00682 

00683     If txtBusyo.Text <> "" Then

00684         Sql = Sql & "  AND A.部署CD = '" & txtBusyo.Text & "' "

00685     End If

00686 

00687     If txtTanto.Text <> "" Then

00688         Sql = Sql & "  AND A.担当者CD = '" & txtTanto.Text & "' "

00689     End If

00690 

00691     If txtTokui.Text <> "" Then

00692         Sql = Sql & "  AND A.得意先CD = '" & txtTokui.Text & "' "

00693     End If

00694 

00695     'データベースを開く (排他モード = False, 読み込み専用 = True)

00696     Dim db As Database

00697     Set db = DBEngine.OpenDatabase(DB_PATH, False, True)

00698     'テーブルを開く

00699     Dim i As Integer: i = 0

00700     Dim rs As Recordset

00701     Set rs = db.OpenRecordset(Sql, dbOpenForwardOnly)

00702     If Not rs.EOF Then

00703         Do Until rs.EOF

00704             ReDim Preserve recDetail(i)

00705             With recDetail(i)

00706                 '伝票番号

00707                 .DenpyoNo = rs("伝票NO") & ""

00708                 '日付

00709                 .Date = rs("日付") & ""

00710                 '部署

00711                 .BusyoCD = rs("部署CD") & ""

00712                 .BusyoNM = rs("部署NM") & ""

00713                 '担当者

00714                 .TantoCD = rs("担当者CD") & ""

00715                 .TantoNM = rs("担当者NM") & ""

00716                 '得意先

00717                 .TokuiCD = rs("得意先CD") & ""

00718                 .TokuiNM = rs("得意先NM") & ""

00719             End With

00720 

00721             i = i + 1

00722             rs.MoveNext

00723         Loop

00724         '明細表示

00725         DispDetail -1

00726     Else

00727         MsgBox "登録されていません。", vbExclamation, "警告"

00728     End If

00729     'テーブルを閉じる

00730     rs.Close

00731     'データベースを閉じる

00732     db.Close

00733 End Sub

00734 '明細表示

00735 Private Sub DispDetail(aStartPos As Integer)

00736     Dim pos As Integer: pos = 0

00737     If aStartPos >= 0 Then

00738         pos = aStartPos

00739     End If

00740 

00741     Dim i As Integer

00742     For i = 0 To ROW_NUM

00743         If (pos + i) > UBound(recDetail) Then Exit For

00744 

00745         With recDetail(pos + i)

00746             'No

00747             aryLblNo(i).Caption = CStr(pos + i + 1)

00748             '伝票番号

00749             aryLblDenpyoNo(i).Caption = .DenpyoNo

00750             '日付

00751             aryLblDate(i).Caption = .Date

00752             '部署

00753             aryLblBusyo(i).Caption = .BusyoNM

00754             '担当者

00755             aryLblTanto(i).Caption = .TantoNM

00756             '得意先

00757             aryLblTokui(i).Caption = .TokuiNM

00758         End With

00759     Next

00760 

00761     '最初だけ、設定

00762     If aStartPos = -1 Then

00763         cmdAppend.Enabled = True

00764         cmdUpdate.Enabled = True

00765         cmdCopy.Enabled = True

00766         cmdDelete.Enabled = True

00767 

00768         vsbDetail.Min = 0

00769         vsbDetail.Value = 0

00770         If UBound(recDetail) > ROW_NUM Then

00771             vsbDetail.Max = UBound(recDetail) - ROW_NUM

00772         Else

00773             vsbDetail.Max = 0

00774         End If

00775     End If

00776 End Sub

00777 'スクロール

00778 Private Sub vsbDetail_Change()

00779     '明細表示

00780     DispDetail vsbDetail.Value

00781 End Sub