reporttransactionlist.frm

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

   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           =   1
      Left            =   9075
      TabIndex        =   5
      Top             =   5625
      Width           =   2040
   End
   Begin VB.Label lblSaldo 
      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
      Left            =   9075
      TabIndex        =   6
      Top             =   6000
      Width           =   2040
   End
   Begin VB.Label lblForm 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Perio&de:"
      Height          =   195
      Index           =   0
      Left            =   225
      TabIndex        =   0
      Top             =   1095
      Width           =   720
   End
End
Attribute VB_Name = "frmReportTransactionList"
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 nDate As String)
On Error GoTo NoView

  Call lvReport.ListItems.Clear

  Dim i As Integer
  i = 1

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

  Call comm.Parameters.Append(comm.CreateParameter("@year", DataTypeEnum.adInteger, , , CInt(Mid(nDate, 1, 4))))
  Call comm.Parameters.Append(comm.CreateParameter("@month", DataTypeEnum.adInteger, , , CInt(Mid(nDate, 6, 2))))

  Call conn.Open
  comm.ActiveConnection = conn

    Set rs = comm.Execute()

    Do While (Not (rs.EOF()))
      Set lx = lvReport.ListItems.Add(, , DigitPrec(CStr(i), 3), , 1)
        Call lx.ListSubItems.Add(, , CStr(rs("TanggalEntry")))
        Call lx.ListSubItems.Add(, , CStr(rs("NoBukti")))
        Call lx.ListSubItems.Add(, , CStr(rs("IdAccount")))
        Call lx.ListSubItems.Add(, , CStr(rs("WorkOrder")))
        Call lx.ListSubItems.Add(, , CStr(rs("IdArea")))
        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 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(Me.Caption, Me.Caption)

End Sub

Private Sub btnView_Click()

  btnView.Enabled = False

  Call ViewReport(CStr(Format(dtPeriode.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()

  Call SetHeader
  dtPeriode.Value = Now

End Sub

Private Sub SetHeader()

  With lvReport.ColumnHeaders
    Call .Add(, , "No", 50)
    Call .Add(, , "Tanggal", 90, ListColumnAlignmentConstants.lvwColumnCenter)
    Call .Add(, , "No Bukti")
    Call .Add(, , "Kode Account", 100)
    Call .Add(, , "WorkOrder", 100)
    Call .Add(, , "Kode Area", 80)
    Call .Add(, , "Uraian", 150)
    Call .Add(, , "Debet", 120, ListColumnAlignmentConstants.lvwColumnRight)
    Call .Add(, , "Kredit", 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(7).Text)
    nKredit = nKredit + CCur(lvReport.ListItems(i).ListSubItems(8).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\TransactionList.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>Periode:</b></td><td>" & Mid(CStr(Format(dtPeriode.Value, DATEFORMAT)), 1, 7) & "</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("Account", "-1") & TableHeader("WO", "-1") & TableHeader("Area", "-1") & TableHeader("Uraian", 98) & TableHeader("Debet", 85, "right") & TableHeader("Kredit", 85, "right")
    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(IIf(EmptyString(lvReport.ListItems(i).ListSubItems(4).Text), "&#160;", lvReport.ListItems(i).ListSubItems(4).Text)) & TableItem(lvReport.ListItems(i).ListSubItems(5).Text) & TableItem(lvReport.ListItems(i).ListSubItems(6).Text) & TableItem(lvReport.ListItems(i).ListSubItems(7).Text, "right") & TableItem(lvReport.ListItems(i).ListSubItems(8).Text, "right")
      Print #f, "</tr>"
    Next i

    Print #f, "<tr><td class='item' colspan='9'>&#160;</td></tr><tr><td class='item' colspan='7' 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='7' 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\TransactionList.html", VbAppWinStyle.vbMaximizedFocus)

End Sub