[求助]分季度汇总各明细科目的数据到LISTVIEW

zbs112 · 发表于 2006-7-6 09:05

窗体选定项目加载代码如下

Private Sub CheckBox1_Change()
On Error Resume Next
With ListView1
    .ColumnHeaders.Add , , "1月", 60
    .ColumnHeaders.Add , , "2月", 60
    .ColumnHeaders.Add , , "3月", 60
    .ColumnHeaders.Add , , "合计", 65
End With
CheckBox1.Enabled = False
End Sub
Private Sub CheckBox2_Change()
On Error Resume Next
With ListView1
    .ColumnHeaders.Add , , "4月", 60
    .ColumnHeaders.Add , , "5月", 60
    .ColumnHeaders.Add , , "6月", 60
    .ColumnHeaders.Add , , "合计", 65
End With
CheckBox2.Enabled = False
End Sub
Private Sub CheckBox3_Change()
On Error Resume Next
With ListView1
    .ColumnHeaders.Add , , "7月", 60
    .ColumnHeaders.Add , , "8月", 60
    .ColumnHeaders.Add , , "9月", 60
    .ColumnHeaders.Add , , "合计", 65
End With
CheckBox3.Enabled = False
End Sub
Private Sub CheckBox4_Change()
On Error Resume Next
With ListView1
    .ColumnHeaders.Add , , "10月", 60
    .ColumnHeaders.Add , , "11月", 60
    .ColumnHeaders.Add , , "12月", 60
    .ColumnHeaders.Add , , "合计", 65
End With
CheckBox4.Enabled = False
End Sub

[此贴子已经被作者于2006-7-6 9:34:36编辑过]

zbs112 · 发表于 2006-7-6 09:35

当选定汇总科目的类别时，LISTVIEW同步刷新的代码如下：

Private Sub ComboBox2_Change()
On Error Resume Next
Stpath = ThisWorkbook.Path & Application.PathSeparator & "分录表.mdb"
CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath
SQL = "select 科目编码,总账科目,明细科目,方向 from kmb where 类型='" & ComboBox2.Text & "' order by 科目编码"
RST.Open SQL, CNN, adOpenKeyset, adLockOptimistic
ListView1.ListItems.Clear
M = RST.RecordCount
PBar1.Max = M '进度条的最大值
For I = 1 To M
    PBar1.Value = I '进度条的动态值
    With ListView1.ListItems.Add(, , RST.Fields("科目编码"))
      .SubItems(1) = IIf(IsNull(RST.Fields("总账科目")), "", RST.Fields("总账科目"))
      .SubItems(2) = IIf(IsNull(RST.Fields("明细科目")), "", RST.Fields("明细科目"))
      .SubItems(3) = IIf(IsNull(RST.Fields("方向")), "", RST.Fields("方向"))
    End With
    RST.MoveNext
Next I
RST.Close
CNN.Close
Set RST = Nothing
Set CNN = Nothing
PBar1.Value = False
End Sub

JJ29IjDO.rar (34.87 KB, 下载次数: 28)

[此贴子已经被作者于2006-7-6 12:06:42编辑过]

zbs112 · 发表于 2006-7-6 12:08

盼高手修改或续写代码

qee用 · 发表于 2006-7-6 15:10

TO:zbs112兄
权做帮你顶一次.
从设计的界面,兄极具灵气的.
而且,依我对您的了解,你是有能力独立完成的,基本的技术元素你都已经掌握了.
象这种专业性很强的东西,我看着就眼晕,写起来实在是繁琐.我很懒,所以....

爱歌学习 · 发表于 2006-7-6 18:16

CvCG5K1k.rar (31.52 KB, 下载次数: 48)

Private Sub CommandButton1_Click()
    Dim summ As Double
    On Error Resume Next
    If ComboBox1.Text = "" Or ComboBox2.Text = "" Or (OptionButton1.Value = False And OptionButton2.Value = False) Then
        ListView1.ListItems.Clear
        MsgBox "请点选科目的类别、年度、借或贷!", vbExclamation, "凭证处理系统"
        Exit Sub
    End If
    With ListView1
        .LabelEdit = lvwManual
        .ColumnHeaders.Clear
        .ListItems.Clear
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        .ColumnHeaders.Add , , "科目编码", 45
        .ColumnHeaders.Add , , "总账科目", 85
        .ColumnHeaders.Add , , "明细科目", 100
        .ColumnHeaders.Add , , "方向", 28
        If CheckBox1.Value = True Then
            .ColumnHeaders.Add , , "1月", 60
            .ColumnHeaders.Add , , "2月", 60
            .ColumnHeaders.Add , , "3月", 60
            .ColumnHeaders.Add , , "合计", 65
        End If
        If CheckBox2.Value = True Then
            .ColumnHeaders.Add , , "4月", 60
            .ColumnHeaders.Add , , "5月", 60
            .ColumnHeaders.Add , , "6月", 60
            .ColumnHeaders.Add , , "合计", 65
        End If
        If CheckBox3.Value = True Then
            .ColumnHeaders.Add , , "7月", 60
            .ColumnHeaders.Add , , "8月", 60
            .ColumnHeaders.Add , , "9月", 60
            .ColumnHeaders.Add , , "合计", 65
        End If
        If CheckBox4.Value = True Then
            .ColumnHeaders.Add , , "10月", 60
            .ColumnHeaders.Add , , "11月", 60
            .ColumnHeaders.Add , , "12月", 60
            .ColumnHeaders.Add , , "合计", 65
        End If
    End With
    Stpath = ThisWorkbook.Path & Application.PathSeparator & "分录表.mdb"
    CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath
    SQL = "select 科目编码,总账科目,明细科目,方向 from kmb where 类型='" & ComboBox2.Text & "' order by 科目编码"
    RST.Open SQL, CNN, adOpenKeyset, adLockOptimistic
    ListView1.ListItems.Clear
    M = RST.RecordCount
    PBar1.Max = M '进度条的最大值
    For I = 1 To M
        PBar1.Value = I '进度条的动态值
        With ListView1.ListItems.Add(, , RST.Fields("科目编码"))
            .SubItems(1) = IIf(IsNull(RST.Fields("总账科目")), "", RST.Fields("总账科目"))
            .SubItems(2) = IIf(IsNull(RST.Fields("明细科目")), "", RST.Fields("明细科目"))
            .SubItems(3) = IIf(IsNull(RST.Fields("方向")), "", RST.Fields("方向"))
            col = 4          '月份从 col 列开始
            For j = 1 To 4   ''遍历 4 个季度
                If Me.Controls("CheckBox" & j).Value = True Then
                    summ = 0
                    For K = col To col + 2
                        If OptionButton1.Value = True Then
                            SSS = "借方金额"
                        End If
                        If OptionButton2.Value = True Then
                            SSS = "贷方金额"
                        End If
                        SQL = "select sum(" & SSS & ") as 月份合计 from flb "
                        SQL = SQL & " where 年=" & ComboBox1.Value & ""
                        SQL = SQL & " and 月=" & K - 3 & ""
                        SQL = SQL & " and 科目编码='" & RST.Fields("科目编码") & "'"
                        RST1.Open SQL, CNN, adOpenKeyset, adLockOptimistic
                        .SubItems(K) = Format(RST1.Fields("月份合计"), "#,##0.00")
                        summ = summ + RST1.Fields("月份合计")
                        Set RST1 = Nothing
                    Next
                    .SubItems(K) = IIf(summ = 0, "", Format(summ, "#,##0.00"))
                    col = col + 4
                End If
            Next
            RST.MoveNext
        End With
    Next
    RST.Close: RST1.Close
    CNN.Close
    Set RST = Nothing: Set CNN = Nothing
    PBar1.Value = False
End Sub

zbs112 · 发表于 2006-7-6 19:03

谢谢爱歌！

你的出招就是经典！

爱歌学习 · 发表于 2006-7-6 21:00

改进：

            For j = 1 To 4   ''遍历 4 个季度
                countt = 0
                If Me.Controls("CheckBox" & j).Value = True Then
                    countt = countt + 1 '选定的季度个数
                    summ = 0
                    For K = col To col + 2
                        If OptionButton1.Value = True Then
                            SSS = "借方金额"
                        End If
                        If OptionButton2.Value = True Then
                            SSS = "贷方金额"
                        End If
                        SQL = "select sum(" & SSS & ") as 月份合计 from flb "
                        SQL = SQL & " where 年=" & ComboBox1.Value & ""
                        SQL = SQL & " and 月=" & (j - 1) * 3 + K - col + 1 & ""
                        SQL = SQL & " and 科目编码='" & RST.Fields("科目编码") & "'"
                        RST1.Open SQL, CNN, adOpenKeyset, adLockOptimistic
                        .SubItems(K) = Format(RST1.Fields("月份合计"), "#,##0.00")
                        summ = summ + RST1.Fields("月份合计")
                        Set RST1 = Nothing
                    Next
                    .SubItems(K) = IIf(summ = 0, "", Format(summ, "#,##0.00"))
                    col = col + 4
                End If
            Next

kUJBqjHF.rar (35.61 KB, 下载次数: 44)

zbs112 · 发表于 2006-7-6 21:34

想让合计的列着色为蓝色，以示区别。

以下的着色代码语句，如何修改？

For I = 1 To RST.RecordCount
   ......
   For J = 1 To 4   '遍历 4 个季度
   ......
      For K = col To col + 2
      ......
      Next K

.SubItems(K) = Format(summ, "#,##0.00")
.ListItems(I).ListSubItems(K).ForeColor = vbBlue

......
Next J
Next I

zbs112 · 发表于 2006-7-6 21:36

可以了，原来是这样的！

.ListSubItems(K).ForeColor = vbBlue

谢谢爱歌学习！

来生缘 · 发表于 2006-7-6 21:40

.SubItems(K) = IIf(summ = 0, "", Format(summ, "#,##0.00"))
                    .ListSubItems(K).ForeColor = vbBlue
                    col = col + 4

加在这

怀疑楼主大佬偷懒不动脑呀

		自动登录	找回密码
密码			免费注册

[求助]分季度汇总各明细科目的数据到LISTVIEW

[求助]请帮忙修改和续写代码（本楼附件）

[求助]要求的结果如图所示