📄 reportlabarugi.frm
字号:
If (lvReport(2).ListItems(i).ListSubItems(1).Tag = "Value01") Then
g(1) = g(1) + CCur(lvReport(2).ListItems(i).ListSubItems(1).Text)
End If
Next i
n = g(0) - g(1)
lblTotal(3).Caption = NoNegative(n)
' #################################################################################
Call CountSubTotal(lvReport(3), lblTotal(5))
lblTotal(2).Caption = NoNegative(CCur(lblTotal(0).Caption) - CCur(lblTotal(1).Caption))
lblTotal(4).Caption = NoNegative(CCur(lblTotal(2).Caption) + CCur(lblTotal(3).Caption))
lblLaba.Caption = NoNegative(CCur(lblTotal(4).Caption) - CCur(lblTotal(5).Caption))
If ((CCur(lblLaba.Caption)) = 0) Then
btnPrint.Enabled = False
Else
btnPrint.Enabled = True
End If
btnView.Enabled = True
End Sub
Private Sub Form_Load()
dtPeriode(0).Value = Now
dtPeriode(1).Value = Now
vsReport.Max = picReport.Height - picContainer.Height
vsReport.LargeChange = picContainer.Height
Call SetHeader
Call FillAccount
End Sub
Private Sub SetHeader()
Dim i As Integer
For i = 0 To 3
Call lvReport(i).ColumnHeaders.Add(, , " ", 460)
Call lvReport(i).ColumnHeaders.Add(, , " ", 120, ListColumnAlignmentConstants.lvwColumnRight)
Next i
End Sub
Private Sub picReport_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If (KeyCode = vbKeyDown) Then
vsReport.Value = vsReport.Value + (vsReport.Max \ 20)
End If
If (KeyCode = vbKeyUp) Then
vsReport.Value = vsReport.Value - (vsReport.Max \ 20)
End If
End Sub
Private Sub vsReport_Change()
Call vsReport_Scroll
End Sub
Private Sub vsReport_Scroll()
picReport.Top = -(vsReport.Value)
End Sub
Private Sub AddSubItem(ByVal nCode As String, ByVal nLevel As Integer, ByVal lvView As ListView, ByVal nGroup As String)
On Error GoTo NoItem
comm.CommandText = "select * from AccountView where (Kode like '" & nCode & "%[^0]');"
comm.CommandType = CommandTypeEnum.adCmdText
Call conn.Open
comm.ActiveConnection = conn
Set rs = comm.Execute()
Do While (Not (rs.EOF()))
Set lx = lvView.ListItems.Add(, , String(nLevel * 2, Chr(32)) & CStr(rs("NamaAccount")))
lx.Tag = CStr(rs("Kode"))
Call lx.ListSubItems.Add(, , "0")
lx.ListSubItems(1).Tag = nGroup
Call rs.MoveNext
Loop
Call conn.Close
Exit Sub
NoItem:
Call CloseConnection(Err)
End Sub
Private Sub FillAccount()
On Error GoTo NoAccount
Dim i As Integer, nItem As String, nFCode As String
' ---------------------------------------------------------------------------------
nItem = "Pendapatan Driving Range#Pendapatan Sewa Ruangan#Pendapatan Food & Beverages#Pendapatan Lainnya"
nFCode = "61#62#63#69"
For i = 0 To 3
Set lx = lvReport(0).ListItems.Add(, , IndexString(nItem, i, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, i, "#"), 1, lvReport(0), "Value")
Next i
' ---------------------------------------------------------------------------------
nItem = "Biaya Pegawai#Biaya Umum dan Kantor#Biaya Pemasaran#Biaya Pemeliharaan Kantor#Biaya Perjalana Dinas#Biaya Penyusutan Aktiva Tetap#Biaya Penyusutan Aktiva Tetap Leasing#Biaya Amortisasi Aktiva Tidak Berwujud#Biaya Jasa Pihak Ketiga#Biaya F&B#Biaya Bunga"
nFCode = "71#72#73#74#75#761#762#763#771#772#773"
For i = 0 To 10
Set lx = lvReport(1).ListItems.Add(, , IndexString(nItem, i, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, i, "#"), 1, lvReport(1), "Value")
Next i
' ---------------------------------------------------------------------------------
nItem = "Pendapatan Lain-lain"
nFCode = "781"
Set lx = lvReport(2).ListItems.Add(, , IndexString(nItem, 0, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, 0, "#"), 1, lvReport(2), "Value00")
' ---------------------------------------------------------------------------------
nItem = "Biaya Lain-lain"
nFCode = "782"
Set lx = lvReport(2).ListItems.Add(, , IndexString(nItem, 0, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, 0, "#"), 1, lvReport(2), "Value01")
' ---------------------------------------------------------------------------------
nItem = "Taksiran Pajak Tangguhan"
nFCode = "79"
Set lx = lvReport(3).ListItems.Add(, , IndexString(nItem, 0, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, 0, "#"), 1, lvReport(3), "Value")
Exit Sub
NoAccount:
Call CloseConnection(Err)
End Sub
Private Sub FillLabaRugiSubItemTotal(ByVal lvView As ListView, ByVal nStart As String, ByVal nEnd As String)
On Error GoTo NoSubItem
Dim i As Integer
comm.CommandText = "AccountLabaRugiDetail"
comm.CommandType = CommandTypeEnum.adCmdStoredProc
Call comm.Parameters.Append(comm.CreateParameter("@accountid", DataTypeEnum.adChar, , 6))
Call comm.Parameters.Append(comm.CreateParameter("@start", DataTypeEnum.adVarChar, , 10, nStart))
Call comm.Parameters.Append(comm.CreateParameter("@end", DataTypeEnum.adVarChar, , 10, nEnd))
Call comm.Parameters.Append(comm.CreateParameter("@total", DataTypeEnum.adVarChar, adParamOutput, 20))
Call conn.Open
comm.ActiveConnection = conn
For i = 1 To lvView.ListItems.Count
If (Left(lvView.ListItems(i).ListSubItems(1).Tag, 5) = "Value") Then
comm.Parameters(0).Value = lvView.ListItems(i).Tag
Call comm.Execute
lvView.ListItems(i).ListSubItems(1).Text = NoNegative(CCur(comm.Parameters(3).Value))
End If
Next i
Call ClearParameter(comm)
Call conn.Close
Exit Sub
NoSubItem:
Call CloseConnection(Err)
End Sub
Private Sub CountSubTotal(ByVal lvView As ListView, ByVal lblLabel As Label)
Dim i As Integer, n As Currency
For i = 1 To lvView.ListItems.Count
If (lvView.ListItems(i).ListSubItems(1).Tag = "Value") Then
n = n + CCur(lvView.ListItems(i).ListSubItems(1).Text)
End If
Next i
lblLabel.Caption = NoNegative(n)
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\LabaRugi.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(Format(dtPeriode(0).Value, DATEFORMAT)) & " sampai " & CStr(Format(dtPeriode(1).Value, DATEFORMAT)) & "</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, "<tr><td class='item' style='font-size:14'><b>" & Replace(lblHeader(0).Caption, "&", "") & "</b></td><td class='item'> </td></tr>"
For i = 1 To lvReport(0).ListItems.Count
If (lvReport(0).ListItems(i).Bold) Then
Print #f, "<tr style='font-weight:bold;'>" & TableItem(lvReport(0).ListItems(i).Text) & TableItem(Replace(lvReport(0).ListItems(i).ListSubItems(1).Text, " ", " ")) & "</tr>"
Else
Print #f, "<tr>" & TableItem(Replace(lvReport(0).ListItems(i).Text, " ", " ")) & TableItem(Replace(lvReport(0).ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
End If
Next i
Print #f, "<tr style='color:#0000ff;'>" & TableItem(" ") & TableItem("<b>" & lblTotal(0).Caption & "</b>", "right") & "</tr>"
Print #f, "<tr>" & TableItem(" ") & TableItem(" ") & "</tr>"
' #################################################################################
Print #f, "<tr><td class='item' style='font-size:12'><b>" & Replace(lblHeader(1).Caption, "&", "") & "</b></td><td class='item'> </td></tr>"
For i = 1 To lvReport(1).ListItems.Count
If (lvReport(1).ListItems(i).Bold) Then
Print #f, "<tr style='font-weight:bold;'>" & TableItem(lvReport(1).ListItems(i).Text) & TableItem(Replace(lvReport(1).ListItems(i).ListSubItems(1).Text, " ", " ")) & "</tr>"
Else
Print #f, "<tr>" & TableItem(Replace(lvReport(1).ListItems(i).Text, " ", " ")) & TableItem(Replace(lvReport(1).ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
End If
Next i
Print #f, "<tr style='color:#0000ff;'>" & TableItem(" ") & TableItem("<b>" & lblTotal(1).Caption & "</b>", "right") & "</tr>"
Print #f, "<tr>" & TableItem(" ") & TableItem(" ") & "</tr>"
' #################################################################################
Print #f, "<tr><td class='item' style='font-size:12'><b>" & Replace(lblHeader(2).Caption, "&", "") & "</b></td><td class='item' style='color:#0000ff;' align='right'><b>" & lblTotal(2).Caption & "</b></td></tr>"
Print #f, "<tr>" & TableItem(" ") & TableItem(" ") & "</tr>"
' #################################################################################
Print #f, "<tr><td class='item' style='font-size:13><b>" & Replace(lblHeader(3).Caption, "&", "") & "</b></td><td class='item'> </td></tr>"
For i = 1 To lvReport(2).ListItems.Count
If (lvReport(2).ListItems(i).Bold) Then
Print #f, "<tr style='font-weight:bold;'>" & TableItem(lvReport(2).ListItems(i).Text) & TableItem(Replace(lvReport(2).ListItems(i).ListSubItems(1).Text, " ", " ")) & "</tr>"
Else
Print #f, "<tr>" & TableItem(Replace(lvReport(2).ListItems(i).Text, " ", " ")) & TableItem(Replace(lvReport(2).ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
End If
Next i
Print #f, "<tr style='color:#0000ff;'>" & TableItem(" ") & TableItem("<b>" & lblTotal(3).Caption & "</b>", "right") & "</tr>"
Print #f, "<tr>" & TableItem(" ") & TableItem(" ") & "</tr>"
' #################################################################################
Print #f, "<tr><td class='item' style='font-size:12'><b>" & Replace(lblHeader(4).Caption, "&", "") & "</b></td><td class='item' style='color:#0000ff;' align='right'><b>" & lblTotal(4).Caption & "</b></td></tr>"
Print #f, "<tr>" & TableItem(" ") & TableItem(" ") & "</tr>"
' #################################################################################
Print #f, "<tr><td class='item' style='font-size:12'><b>" & Replace(lblHeader(5).Caption, "&", "") & "</b></td><td class='item'> </td></tr>"
For i = 1 To lvReport(3).ListItems.Count
If (lvReport(3).ListItems(i).Bold) Then
Print #f, "<tr style='font-weight:bold;'>" & TableItem(lvReport(3).ListItems(i).Text) & TableItem(Replace(lvReport(3).ListItems(i).ListSubItems(1).Text, " ", " ")) & "</tr>"
Else
Print #f, "<tr>" & TableItem(Replace(lvReport(3).ListItems(i).Text, " ", " ")) & TableItem(Replace(lvReport(3).ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
End If
Next i
Print #f, "<tr style='color:#0000ff;'>" & TableItem(" ") & TableItem("<b>" & lblTotal(5).Caption & "</b>", "right") & "</tr>"
Print #f, "<tr>" & TableItem(" ") & TableItem(" ") & "</tr>"
Print #f, "</table>"
Print #f, "</td></tr></table>"
Print #f, "<table cellpadding='2' cellspacing='0' width='83%'>"
Print #f, "<tr><td class='item' align='right'><b>Laba Bersih</b></td><td class='item' align='right'><b>" & lblLaba.Caption & "</b></td></tr>"
Print #f, "</table>"
Print #f, LoadResString(600)
Close #f
Call Shell("Explorer.exe /n, " & App.Path & "\..\Report\LabaRugi.html", VbAppWinStyle.vbMaximizedFocus)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -