📄 reportneraca.frm
字号:
Call lx.ListSubItems.Add(, , "0")
lx.ListSubItems(1).Bold = True
lx.ListSubItems(1).ForeColor = RGB(0, 0, 255)
Set lx = lvActiva.ListItems.Add(, , " "): Call lx.ListSubItems.Add(, , " ")
Exit Sub
NoActiva:
Call CloseConnection(Err)
End Sub
Private Sub FillPassiva()
On Error GoTo NoPassiva
Dim i As Integer, nItem As String, nFCode As String
' ---------------------------------------------------------------------------------
Set lx = lvPassiva.ListItems.Add(, , "KEWAJIBAN JANGKA PENDEK")
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
nItem = "Hutang Jangka Pendek#Hutang Usaha#Hutang Pajak#Hutang Lain-lain#Biaya Yang Masih Harus Dibayar"
nFCode = "31#32#33#34#35"
For i = 0 To 4
Set lx = lvPassiva.ListItems.Add(, , String(2, Chr(32)) & IndexString(nItem, i, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, i, "#"), 2, lvPassiva, "Group01")
Next i
Set lx = lvPassiva.ListItems.Add(, , " Sub Total")
lx.Bold = True
lx.ForeColor = RGB(0, 0, 255)
lx.Tag = "Total01"
Call lx.ListSubItems.Add(, , "0")
lx.ListSubItems(1).Bold = True
lx.ListSubItems(1).ForeColor = RGB(0, 0, 255)
' ---------------------------------------------------------------------------------
Set lx = lvPassiva.ListItems.Add(, , " "): Call lx.ListSubItems.Add(, , " ")
Set lx = lvPassiva.ListItems.Add(, , "KEWAJIBAN JANGKA PANJANG")
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
nItem = "Kewajiban Kepada Pemegang Saham#Jaminan Sewa#Kewajiban Sewa Guna Usaha#Kewajiban Pajak Tangguhan"
nFCode = "41#42#43#44"
For i = 0 To 3
Set lx = lvPassiva.ListItems.Add(, , String(2, Chr(32)) & IndexString(nItem, i, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, i, "#"), 2, lvPassiva, "Group02")
Next i
Set lx = lvPassiva.ListItems.Add(, , " Sub Total")
lx.Bold = True
lx.ForeColor = RGB(0, 0, 255)
lx.Tag = "Total02"
Call lx.ListSubItems.Add(, , "0")
lx.ListSubItems(1).Bold = True
lx.ListSubItems(1).ForeColor = RGB(0, 0, 255)
' ---------------------------------------------------------------------------------
Set lx = lvPassiva.ListItems.Add(, , " "): Call lx.ListSubItems.Add(, , " ")
Set lx = lvPassiva.ListItems.Add(, , "EKUITAS")
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
nItem = "Modal Dasar Saham Pada Tahun " & CStr(Year(Now) - 1) & "#Modal Ditempatkan Dan Disetor#Agio Saham#Selisih Penilaian Kembali Aktiva Tetap#Cadangan Umum#Saldo Laba Ditahan Tahun Lalu#Saldo Laba Rugi Tahun Berjalan"
nFCode = "51#52#53#54#55#56#57"
For i = 0 To 6
Set lx = lvPassiva.ListItems.Add(, , String(2, Chr(32)) & IndexString(nItem, i, "#"))
lx.Bold = True
Call lx.ListSubItems.Add(, , " ")
Call AddSubItem(IndexString(nFCode, i, "#"), 2, lvPassiva, "Group03")
Next i
Set lx = lvPassiva.ListItems.Add(, , " Sub Total")
lx.Bold = True
lx.ForeColor = RGB(0, 0, 255)
lx.Tag = "Total03"
Call lx.ListSubItems.Add(, , "0")
lx.ListSubItems(1).Bold = True
lx.ListSubItems(1).ForeColor = RGB(0, 0, 255)
Set lx = lvPassiva.ListItems.Add(, , " "): Call lx.ListSubItems.Add(, , " ")
Exit Sub
NoPassiva:
Call CloseConnection(Err)
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 FillActivaSubItemTotal(ByVal nYear As Integer, ByVal nMonth As Integer)
On Error GoTo NoDetail
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 lvActiva.ListItems.Count
If (Not (lvActiva.ListItems(i).Tag = "")) Then
If (Not (Trim(lvActiva.ListItems(i).Text) = "Sub Total")) Then
comm.Parameters(0).Value = lvActiva.ListItems(i).Tag
Call comm.Execute
lvActiva.ListItems(i).ListSubItems(1).Text = NoNegative(CCur(comm.Parameters(3).Value))
End If
End If
Next i
Call ClearParameter(comm)
Call conn.Close
Exit Sub
NoDetail:
Call CloseConnection(Err)
End Sub
Private Sub FillPassivaSubItemTotal(ByVal nYear As Integer, ByVal nMonth As Integer)
On Error GoTo NoDetail
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 lvPassiva.ListItems.Count
If (Not (lvPassiva.ListItems(i).Tag = "")) Then
If (Not (Trim(lvPassiva.ListItems(i).Text) = "Sub Total")) Then
comm.Parameters(0).Value = lvPassiva.ListItems(i).Tag
Call comm.Execute
lvPassiva.ListItems(i).ListSubItems(1).Text = NoNegative(CCur(comm.Parameters(3).Value))
End If
End If
Next i
Call ClearParameter(comm)
Call conn.Close
Exit Sub
NoDetail:
Call CloseConnection(Err)
End Sub
Private Sub CountActiva()
Dim i As Integer
Dim n As Currency
' ---------------------------------------------------------------------------------
n = 0
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).ListSubItems(1).Tag = "Group01") Then
n = n + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).Tag = "Total01") Then
lvActiva.ListItems(i).ListSubItems(1).Text = NoNegative(n)
Exit For
End If
Next i
' ---------------------------------------------------------------------------------
Dim g1 As Currency, g2 As Currency
n = 0
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).ListSubItems(1).Tag = "Group02") Then
n = n + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
g1 = 0
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).ListSubItems(1).Tag = "Group03") Then
g1 = g1 + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
g2 = 0
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).ListSubItems(1).Tag = "Group04") Then
g2 = g2 + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
n = n + (g1 - g2)
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).Tag = "Total04") Then
lvActiva.ListItems(i).ListSubItems(1).Text = NoNegative(n)
Exit For
End If
Next i
' ---------------------------------------------------------------------------------
g1 = 0
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).ListSubItems(1).Tag = "Group05") Then
g1 = g1 + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
g2 = 0
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).ListSubItems(1).Tag = "Group06") Then
g2 = g2 + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
n = g1 - g2
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).Tag = "Total06") Then
lvActiva.ListItems(i).ListSubItems(1).Text = NoNegative(n)
Exit For
End If
Next i
' ---------------------------------------------------------------------------------
n = 0
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).ListSubItems(1).Tag = "Group07") Then
n = n + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).Tag = "Total07") Then
lvActiva.ListItems(i).ListSubItems(1).Text = NoNegative(n)
Exit For
End If
Next i
' ---------------------------------------------------------------------------------
n = 0
For i = 1 To lvActiva.ListItems.Count
If (Trim(lvActiva.ListItems(i).Text) = "Sub Total") Then
n = n + CCur(lvActiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
lblTotal(0).Caption = NoNegative(n)
End Sub
Private Sub CountPassiva()
Dim i As Integer
Dim n As Currency
' ---------------------------------------------------------------------------------
n = 0
For i = 1 To lvPassiva.ListItems.Count
If (lvPassiva.ListItems(i).ListSubItems(1).Tag = "Group01") Then
n = n + CCur(lvPassiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
For i = 1 To lvPassiva.ListItems.Count
If (lvPassiva.ListItems(i).Tag = "Total01") Then
lvPassiva.ListItems(i).ListSubItems(1).Text = NoNegative(n)
Exit For
End If
Next i
' ---------------------------------------------------------------------------------
n = 0
For i = 1 To lvPassiva.ListItems.Count
If (lvPassiva.ListItems(i).ListSubItems(1).Tag = "Group02") Then
n = n + CCur(lvPassiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
For i = 1 To lvPassiva.ListItems.Count
If (lvPassiva.ListItems(i).Tag = "Total02") Then
lvPassiva.ListItems(i).ListSubItems(1).Text = NoNegative(n)
Exit For
End If
Next i
' ---------------------------------------------------------------------------------
n = 0
For i = 1 To lvPassiva.ListItems.Count
If (lvPassiva.ListItems(i).ListSubItems(1).Tag = "Group02") Then
n = n + CCur(lvPassiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
For i = 1 To lvPassiva.ListItems.Count
If (lvPassiva.ListItems(i).Tag = "Total02") Then
lvPassiva.ListItems(i).ListSubItems(1).Text = NoNegative(n)
Exit For
End If
Next i
' ---------------------------------------------------------------------------------
n = 0
For i = 1 To lvPassiva.ListItems.Count
If (Trim(lvPassiva.ListItems(i).Text) = "Sub Total") Then
n = n + CCur(lvPassiva.ListItems(i).ListSubItems(1).Text)
End If
Next i
lblTotal(1).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\Neraca.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>Per:</b></td><td>" & Mid(CStr(Format(dtPeriode.Value, DATEFORMAT)), 1, 7) & "</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%'>"
For i = 1 To lvActiva.ListItems.Count
If (lvActiva.ListItems(i).Bold) Then
If (Trim(lvActiva.ListItems(i).Text) = "Sub Total") Then
Print #f, "<tr style='font-weight:bold; color:blue;'>" & TableItem(lvActiva.ListItems(i).Text) & TableItem(Replace(lvActiva.ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
Else
Print #f, "<tr style='font-weight:bold;'>" & TableItem(lvActiva.ListItems(i).Text) & TableItem(Replace(lvActiva.ListItems(i).ListSubItems(1).Text, " ", " ")) & "</tr>"
End If
Else
Print #f, "<tr>" & TableItem(Replace(lvActiva.ListItems(i).Text, " ", " ")) & TableItem(Replace(lvActiva.ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
End If
Next i
Print #f, "</table>"
Print #f, "</td><td valign='top'>"
Print #f, "<table cellpadding='2' cellspacing='0' width='90%'>"
For i = 1 To lvPassiva.ListItems.Count
If (lvPassiva.ListItems(i).Bold) Then
If (Trim(lvPassiva.ListItems(i).Text) = "Sub Total") Then
Print #f, "<tr style='font-weight:bold; color:blue;'>" & TableItem(lvPassiva.ListItems(i).Text) & TableItem(Replace(lvPassiva.ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
Else
Print #f, "<tr style='font-weight:bold;'>" & TableItem(lvPassiva.ListItems(i).Text) & TableItem(Replace(lvPassiva.ListItems(i).ListSubItems(1).Text, " ", " ")) & "</tr>"
End If
Else
Print #f, "<tr>" & TableItem(Replace(lvPassiva.ListItems(i).Text, " ", " ")) & TableItem(Replace(lvPassiva.ListItems(i).ListSubItems(1).Text, " ", " "), "right") & "</tr>"
End If
Next i
Print #f, "</table>"
Print #f, "</td></tr></table>"
Print #f, "<table cellpadding='2' cellspacing='0' width='90%'>"
Print #f, "<tr><td class='item' colspan='2'> </td></tr>"
Print #f, "<tr style='font-weight:bold;'><td class='item' align='right' width='45%'>" & lblTotal(0).Caption & "</td><td class='item' align='right' width='45%'>" & lblTotal(1).Caption & "</td></tr>"
Print #f, "</table>"
Print #f, LoadResString(600)
Close #f
Call Shell("Explorer.exe /n, " & App.Path & "\..\Report\Neraca.html", VbAppWinStyle.vbMaximizedFocus)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -