reportgl.frm

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

      Left            =   6975
      TabIndex        =   4
      Top             =   6000
      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            =   4875
      TabIndex        =   3
      Top             =   6000
      Width           =   2040
   End
   Begin VB.Label lblForm 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Pe&riode:"
      Height          =   195
      Index           =   0
      Left            =   225
      TabIndex        =   0
      Top             =   1095
      Width           =   720
   End
End
Attribute VB_Name = "frmReportGl"
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 btnPrint_Click()

  Call ShowReport("GL Summary", "GL Summary")

End Sub

Private Sub btnView_Click()

  btnView.Enabled = False

  Dim nDate As Date
  nDate = CDate(dtPeriode.Value)

  Call FillSubItemTotal(CInt(Year(nDate)), CInt(Month(nDate)), 4)

  nDate = DateAdd("M", -1, nDate)
  Call FillSubItemTotal(CInt(Year(nDate)), CInt(Month(nDate)), 3)

  Call CountAmount

  If (CCur(lblTotal(2).Caption) = 0) Then
    btnPrint.Enabled = False
  Else
    btnPrint.Enabled = True
  End If

  btnView.Enabled = True

End Sub

Private Sub btnClose_Click()

  Call Unload(Me)

End Sub

Private Sub Form_Load()

  dtPeriode.Value = Now

  Call SetHeader
  Call FillAccount

End Sub

Private Sub SetHeader()

  With lvReport.ColumnHeaders
    Call .Add(, , "No", 50)
    Call .Add(, , "Account Code", 90)
    Call .Add(, , "Account Name", 180)
    Call .Add(, , "Amount Last Period", 135, ListColumnAlignmentConstants.lvwColumnRight)
    Call .Add(, , "Amount This Period", 135, ListColumnAlignmentConstants.lvwColumnRight)
    Call .Add(, , "Total Amount", 120, ListColumnAlignmentConstants.lvwColumnRight)
  End With

End Sub

Private Sub FillAccount()
On Error GoTo NoAccount

  Dim i As Integer
  i = 1

  comm.CommandText = "  select * from AccountNoHeaderView;"
  comm.CommandType = CommandTypeEnum.adCmdText

  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("Kode")))
        Call lx.ListSubItems.Add(, , CStr(rs("NamaAccount")))
        Call lx.ListSubItems.Add(, , "0")
        Call lx.ListSubItems.Add(, , "0")
        Call lx.ListSubItems.Add(, , "0")

      i = i + 1
      Call rs.MoveNext
    Loop

  Call conn.Close

Exit Sub
NoAccount:

  Call CloseConnection(Err)

End Sub

Private Sub FillSubItemTotal(ByVal nYear As Integer, ByVal nMonth As Integer, ByVal nIndex As Integer)
On Error GoTo NoSubItem

  Dim i As Integer

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

  Call comm.Parameters.Append(comm.CreateParameter("@accountid", DataTypeEnum.adChar, , 6))
  Call comm.Parameters.Append(comm.CreateParameter("@year", DataTypeEnum.adSmallInt, , , nYear))
  Call comm.Parameters.Append(comm.CreateParameter("@month", DataTypeEnum.adTinyInt, , , nMonth))
  Call comm.Parameters.Append(comm.CreateParameter("@total", DataTypeEnum.adVarChar, adParamOutput, 20))

  Call conn.Open
  comm.ActiveConnection = conn

    For i = 1 To lvReport.ListItems.Count
      comm.Parameters(0).Value = lvReport.ListItems(i).ListSubItems(1).Text
      Call comm.Execute

      lvReport.ListItems(i).ListSubItems(nIndex).Text = NoNegative(CCur(comm.Parameters(3).Value))
    Next i

  Call ClearParameter(comm)
  Call conn.Close

Exit Sub
NoSubItem:

  Call CloseConnection(Err)

End Sub

Private Sub CountAmount()

  Dim i As Integer
  Dim n(2) As Currency

  n(0) = 0: n(1) = 0: n(2) = 0

  For i = 1 To lvReport.ListItems.Count
    lvReport.ListItems(i).ListSubItems(5).Text = NoNegative(CCur(lvReport.ListItems(i).ListSubItems(3).Text) + CCur(lvReport.ListItems(i).ListSubItems(4).Text))

    n(0) = n(0) + lvReport.ListItems(i).ListSubItems(3).Text
    n(1) = n(1) + lvReport.ListItems(i).ListSubItems(4).Text
    n(2) = n(2) + lvReport.ListItems(i).ListSubItems(5).Text
  Next i

  lblTotal(0).Caption = NoNegative(n(0))
  lblTotal(1).Caption = NoNegative(n(1))
  lblTotal(2).Caption = NoNegative(n(2))

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\Gl.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>" & CStr(dtPeriode.Year) & "-" & CStr(dtPeriode.Month) & "</td></tr>"
    Print #f, "</table><br/>"

    Print #f, "<table cellpadding='2' cellspacing='0' width='90%'><tr><td valign='top'>"
    Print #f, "<table cellpadding='2' cellspacing='0' width='90%'>"

    ' #################################################################################

    Print #f, "<table cellpadding='2' cellspacing='0'><tr class='headerrow'>"
    Print #f, TableHeader("No", "-1") & TableHeader("Account Code", "-1") & TableHeader("Account Name", "-1") & TableHeader("Amount Last Period", "-1") & TableHeader("Amount This Period", "-1") & TableHeader("Total Amount", "-1")
    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, "right") & TableItem(lvReport.ListItems(i).ListSubItems(4).Text, "right") & TableItem(lvReport.ListItems(i).ListSubItems(5).Text, "right")
      Print #f, "</tr>"
    Next i

    Print #f, "<tr><td colspan='6' class='item'>&#160;</td></tr>"
    Print #f, "<tr><td colspan='3' class='item' align='right'>Total</td>" & TableItem("<b>" & lblTotal(0).Caption & "</b>", "right") & TableItem("<b>" & lblTotal(1).Caption & "</b>", "right") & TableItem("<b>" & lblTotal(1).Caption & "</b>", "right") & "</tr>"

    Print #f, "</table>"

    Print #f, LoadResString(600)

  Close #f

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

End Sub