accountreport.frm

来自「This application i made for handle simpl」· FRM 代码 · 共 534 行 · 第 1/2 页

FRM
534
字号
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   315
      Index           =   1
      Left            =   9150
      TabIndex        =   11
      Top             =   5625
      Width           =   2040
   End
   Begin VB.Label lblTotal 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00F0E0D5&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   315
      Index           =   0
      Left            =   7050
      TabIndex        =   10
      Top             =   5625
      Width           =   2040
   End
   Begin VB.Label lblForm 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "&Sampai Dengan:"
      Height          =   195
      Index           =   3
      Left            =   6675
      TabIndex        =   6
      Top             =   1470
      Width           =   1440
   End
   Begin VB.Label lblForm 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Perio&de:"
      Height          =   195
      Index           =   2
      Left            =   6675
      TabIndex        =   4
      Top             =   1095
      Width           =   720
   End
   Begin VB.Label lblForm 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "&Kode Account:"
      Height          =   195
      Index           =   0
      Left            =   225
      TabIndex        =   0
      Top             =   1095
      Width           =   1245
   End
   Begin VB.Label lblForm 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "&Nama Account:"
      Height          =   195
      Index           =   1
      Left            =   225
      TabIndex        =   2
      Top             =   1470
      Width           =   1305
   End
End
Attribute VB_Name = "frmAccountReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Option Explicit

Private lx As MSComctlLib.ListItem


Private Sub btnClose_Click()

  Call Unload(Me)

End Sub

Private Sub ViewReport(ByVal nAccount As String, ByVal nStart As String, ByVal nEnd As String)
On Error GoTo NoView

  Call lvReport.ListItems.Clear

  Dim i As Integer
  i = 1

  comm.CommandText = "AccountReport"
  comm.CommandType = CommandTypeEnum.adCmdStoredProc

  Call comm.Parameters.Append(comm.CreateParameter("@accountid", DataTypeEnum.adChar, , 6, nAccount))
  Call comm.Parameters.Append(comm.CreateParameter("@start", DataTypeEnum.adChar, , 10, nStart))
  Call comm.Parameters.Append(comm.CreateParameter("@end", DataTypeEnum.adChar, , 10, nEnd))

  Call conn.Open
  comm.ActiveConnection = conn

    Set rs = comm.Execute()

    Do While (Not (rs.EOF()))
      Set lx = lvReport.ListItems.Add(, , DigitPrec(CStr(i), 2), , 1)
        Call lx.ListSubItems.Add(, , CStr(rs("TanggalEntry")))
        Call lx.ListSubItems.Add(, , CStr(rs("NoBukti")))
        Call lx.ListSubItems.Add(, , CStr(rs("Uraian")))
        Call lx.ListSubItems.Add(, , CStr(Format(rs("Debet"), INTNUMFORMAT)))
        Call lx.ListSubItems.Add(, , CStr(Format(rs("Kredit"), INTNUMFORMAT)))
        Call lx.ListSubItems.Add(, , CStr(rs("MataUang")))
        Call lx.ListSubItems.Add(, , CStr(rs("Kurs")))
      Call rs.MoveNext
      i = i + 1
    Loop

  Call ClearParameter(comm)
  Call conn.Close

Exit Sub
NoView:

  Call CloseConnection(Err)

End Sub

Private Sub btnPrint_Click()

  Call ShowReport("Account Report", "Account Report")

End Sub

Private Sub btnView_Click()

  btnView.Enabled = False

  Call ViewReport(Trim(txtCode.Text), CStr(Format(dtStart.Value, DATEFORMAT)), CStr(Format(dtEnd.Value, DATEFORMAT)))
  Call CountList

  If (lvReport.ListItems.Count = 0) Then
    btnPrint.Enabled = False
  Else
    btnPrint.Enabled = True
  End If

  btnView.Enabled = True

End Sub

Private Sub Form_Load()

  dtStart.Value = Now
  dtEnd.Value = Now

  With frmAccount.lvAccount.SelectedItem
    txtCode.Text = .Text
    txtName.Text = .ListSubItems(1).Text
  End With

  Call SetHeader

End Sub

Private Sub SetHeader()

  With lvReport.ColumnHeaders
    Call .Add(, , "No", 40)
    Call .Add(, , "Tanggal", 90, ListColumnAlignmentConstants.lvwColumnCenter)
    Call .Add(, , "No Bukti")
    Call .Add(, , "Uraian", 150)
    Call .Add(, , "Debet", 120, ListColumnAlignmentConstants.lvwColumnRight)
    Call .Add(, , "Kredit", 120, ListColumnAlignmentConstants.lvwColumnRight)
    Call .Add(, , "Valuta")
    Call .Add(, , "Kurs", 120, ListColumnAlignmentConstants.lvwColumnRight)
  End With

End Sub

Private Sub CountList()

  Dim i As Integer
  Dim nDebet As Currency, nKredit As Currency
  Dim nSaldo As Currency

  nDebet = 0
  nKredit = 0
  nSaldo = 0

  For i = 1 To lvReport.ListItems.Count
    nDebet = nDebet + CCur(lvReport.ListItems(i).ListSubItems(4).Text)
    nKredit = nKredit + CCur(lvReport.ListItems(i).ListSubItems(5).Text)
  Next i

  lblTotal(0).Caption = CStr(Format(nDebet, INTNUMFORMAT))
  lblTotal(1).Caption = CStr(Format(nKredit, INTNUMFORMAT))

  nSaldo = nDebet - nKredit

  If (nSaldo < 0) Then
    lblSaldo.Caption = "(" & CStr(Format(Abs(nSaldo), INTNUMFORMAT)) & ")"
  Else
    lblSaldo.Caption = CStr(Format(nSaldo, INTNUMFORMAT))
  End If

End Sub

Private Sub ShowReport(ByVal mainTitle As String, ByVal subTitle As String)

  Call CreateFolder("Report")

  Dim i As Integer, f As Integer
  f = FreeFile

  Open App.Path & "\..\Report\Account.html" For Output As #f

    Print #f, Replace(LoadResString(500), "@title", mainTitle)
    Print #f, LoadResString(501)
    Print #f, LoadResString(502)
    Print #f, LoadResString(503)
    Print #f, Replace(LoadResString(504), "@title", subTitle)

    Print #f, "<br/><table cellpadding='2' cellspacing='0'>"
    Print #f, "<tr><td><b>Kode:</b></td><td>" & frmAccountReport.txtCode.Text & "</td></tr>"
    Print #f, "<tr><td><b>Nama Account:</b></td><td>" & frmAccountReport.txtName.Text & "</td></tr>"
    Print #f, "<tr><td><b>Periode:</b></td><td>" & CStr(Format(frmAccountReport.dtStart.Value, DATEFORMAT)) & " sampai " & CStr(Format(frmAccountReport.dtEnd.Value, DATEFORMAT)) & "</td></tr>"
    Print #f, "</table><br/>"

    Print #f, "<table cellpadding='2' cellspacing='0'><tr class='headerrow'>"
    Print #f, TableHeader("No", "-1") & TableHeader("Tanggal", "-1") & TableHeader("No Bukti", "-1") & TableHeader("Uraian", 120) & TableHeader("Debet", 120, "right") & TableHeader("Kredit", 120, "right") & TableHeader("Valuta", 120)
    Print #f, "</tr>"

    For i = 1 To lvReport.ListItems.Count
      Print #f, "<tr>"
      Print #f, TableItem(lvReport.ListItems(i).Text) & TableItem(lvReport.ListItems(i).ListSubItems(1).Text) & TableItem(lvReport.ListItems(i).ListSubItems(2).Text) & TableItem(lvReport.ListItems(i).ListSubItems(3).Text) & TableItem(lvReport.ListItems(i).ListSubItems(4).Text, "right") & TableItem(lvReport.ListItems(i).ListSubItems(5).Text, "right") & TableItem(lvReport.ListItems(i).ListSubItems(6).Text)
      Print #f, "</tr>"
    Next i

    Print #f, "<tr><td class='item' colspan='7'>&#160;</td></tr><tr><td class='item' colspan='4' align='right'>Jumlah</td>" & TableItem(lblTotal(0).Caption, "right") & TableItem(lblTotal(1).Caption, "right") & "<td class='item'>&#160;</td></tr>"
    Print #f, "<tr><td class='item' colspan='4' align='right'>Saldo Akhir</td><td colspan='2' class='item' align='right'><b>" & lblSaldo.Caption & "</b></td><td class='item'>&#160;</td></tr>"
    Print #f, LoadResString(600)

  Close #f

  Call Shell("Explorer.exe /n, " & App.Path & "\..\Report\Account.html", VbAppWinStyle.vbMaximizedFocus)

End Sub


⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?