Private Sub cmd_report_Click()
If lst_selected.ListCount <> 0 Then
Call fieldwidth(lst_selected) '设置字段宽度
Call setDatareport(lst_selected, Dtreport, Trim$(txt_caption))
Dtreport.Show
Else
MsgBox "请选择要输出的字段条目", vbOKOnly + vbInformation
End If
End Sub
'***********************************************************************************
'Section1,Section2的keeptogther=true时,如果某条记录处在一页最下面,但又不完全能打印出来时,可强制将此条记录换到下一页打印。
'Rpttextbox、Rptlable和RptFunction中Gangrow=true时当显示的内容超过控件的宽度是可以换行。
'打印报表字段宽度控制子程序
Private Sub fieldwidth(lst As ListBox)
Dim i As Integer
Const wordwidth As Integer = 201 '五号字的宽带是201缇
For i = 0 To lst.ListCount - 1
Select Case lst.List(i)
Case "编号"
lst.ItemData(i) = wordwidth * 4
Case "名称"
lst.ItemData(i) = wordwidth * 12
Case "款号"
lst.ItemData(i) = wordwidth * 4
Case "规格"
lst.ItemData(i) = wordwidth * 3
Case "件数"
lst.ItemData(i) = wordwidth * 3
Case "重量g"
lst.ItemData(i) = wordwidth * 3
Case "单价类型"
lst.ItemData(i) = wordwidth * 4
Case "单价"
lst.ItemData(i) = wordwidth * 3
End Select
Next i
End Sub
'***********************************************************************************
'***********************************************************************************
'设置报表窗体各种参数,控制输出格式
Private Sub setDatareport(lst As ListBox, dtr As DataReport, scaption As String)
Dim leftpos As Long 'leftpos为存放控件left属性的变量
Dim reportwidth As Long 'reportwidth为存放DataReport总宽度的变量
Dim i As Integer
Dim Rst1 As New ADODB.Recordset '定义一个数据库记录对象
Dim SqlDef As String '定义字符串变量
'求总宽度
For i = 0 To lst.ListCount - 1
reportwidth = reportwidth + lst.ItemData(i)
Next i
'初始化
If VSFlexGrid1.Rows >= 1 Then dh1 = VSFlexGrid1.TextMatrix(VSFlexGrid1.RowSel, 1)
''''SqlDef = "select BH AS 编号,MC AS 名称,KH AS 款号,GG AS 规格,JS AS 件数,ZL AS 重量g,DJLX AS 单价类型," & _
'''' "DJ AS 单价,JE AS 金额,GFLX AS 工费类型,GF AS 工费,GFJE AS 工费金额,ZJE AS 总金额,SJ AS 售价,BZ AS 备注 from YSPF_ZC_PLRKDMX where DH='" & dh1 & "'"
SqlDef = "select BH AS 编号,MC AS 名称,KH AS 款号,GG AS 规格,JS AS 件数,ZL AS 重量g,DJLX AS 单价类型," & _
"DJ AS 单价 from YSPF_FD_RKDMX where DH='" & dh1 & "'"
Rst1.Open SqlDef, gConn, adOpenStatic, adLockReadOnly, -1 '进入数据库查询,并把查询结果赋值给rst记录对象
With dtr
'设置数据源,页边距、标题、横向分割线,section1.2区第一条竖向分割线
.LeftMargin = 1440
.RightMargin = 1440
.TopMargin = 1440
.BottomMargin = 144
'.reportwidth = Printer.With - 2880 - 20
Set .DataSource = Rst1 'Rst1为数据源
.Sections("Section4").Controls.Item("label1").Caption = scaption
.Sections("Section4").Controls.Item("label1").Width = reportwidth
.Sections("Section4").Controls.Item("label2").Width = reportwidth
.Sections("Section2").Controls.Item("line2").Width = reportwidth
.Sections("Section2").Controls.Item("line_2").Width = reportwidth
.Sections("Section1").Controls.Item("line1").Width = reportwidth
.Sections("Section2").Controls.Item("line20").Left = 0
.Sections("Section1").Controls.Item("line10").Left = 0
End With
'为section1,2区设置数据
leftpos = 0
For i = 0 To lst.ListCount - 1
dtr.Sections("Section2").Controls.Item("label1" & (i + 1)).Caption = lst.List(i)
dtr.Sections("Section2").Controls.Item("label1" & (i + 1)).Width = lst.ItemData(i)
dtr.Sections("Section2").Controls.Item("label1" & (i + 1)).Left = leftpos
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).DataField = lst.List(i)
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).Width = lst.ItemData(i)
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).Left = leftpos
dtr.Sections("Section1").Controls.Item("line1" & (i + 1)).Left = leftpos + lst.ItemData(i)
dtr.Sections("Section2").Controls.Item("line2" & (i + 1)).Left = leftpos + lst.ItemData(i)
leftpos = leftpos + lst.ItemData(i)
'特殊字体的格式特殊处理
If lst.List(i) = "收盘价" Then
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).DataFormat.Format = "#,##0"
End If
Next i
'对不用的text控件必须设置datafield属性,如lst.list(0),否则出错,但一定让其不可见
'其他不用的lable,line控件同样均不可见
i = lst.ListCount
While i < (dtr.Sections("Section1").Controls.Count - 10)
'10 为Section1区域的非text控件的控件总数
i = i + 1
dtr.Sections("Section1").Controls.Item("text1" & i).DataField = lst.List(1)
dtr.Sections("Section1").Controls.Item("text1" & i).Visible = False
dtr.Sections("Section1").Controls.Item("line1" & i).Visible = False
dtr.Sections("Section2").Controls.Item("line2" & i).Visible = False
dtr.Sections("Section2").Controls.Item("label1" & i).Visible = False
Wend
End Sub
'***********************************************************************************
Private Sub Command20_Click()
If lst_candidate.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
'如果lst_candidate中没有列表项则退出
If lst_candidate.ListIndex = -1 Then
lst_candidate.SetFocus
lst_candidate.Selected(0) = True
End If
'如果lst_candidate中没有选中的列表项则选择第一个列表项
DoEvents
lst_selected.AddItem lst_candidate.Text
lst_candidate.RemoveItem lst_candidate.ListIndex
End Sub
Private Sub Command21_Click()
If lst_selected.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
'如果lst_selected中没有列表项则退出
If lst_selected.ListIndex = -1 Then
lst_selected.SetFocus
lst_selected.Selected(0) = True
End If
'如果lst_selected中没有选中的列表项则选择第一个列表项
lst_candidate.AddItem lst_selected.Text
lst_selected.RemoveItem lst_selected.ListIndex
'将选择的列表项从lst_selected移到lst_candidate
End Sub
Private Sub Command22_Click()
If lst_candidate.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
'如果lst_candidate中没有列表项则退出
If lst_candidate.ListIndex = -1 Then
lst_candidate.SetFocus
lst_candidate.Selected(0) = True
End If
'如果lst_candidate中没有选中的列表项则选择第一个列表项
DoEvents
For i = (lst_candidate.ListCount - 1) To 0 Step -1
lst_selected.AddItem lst_candidate.List(i)
DoEvents
Next i
'将lst_candidate的所有列表项添加到lst_selected中
lst_candidate.Clear
'删除lst_candidate中的所有列表项
End Sub
Private Sub Command23_Click()
If lst_selected.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
If lst_selected.ListCount = 0 Then Exit Sub
If lst_selected.ListIndex = -1 Then
lst_selected.SetFocus
lst_selected.Selected(0) = True
End If
For i = (lst_selected.ListCount - 1) To 0 Step -1
lst_candidate.AddItem lst_selected.List(i)
DoEvents
Next i
lst_selected.Clear
End Sub
If lst_selected.ListCount <> 0 Then
Call fieldwidth(lst_selected) '设置字段宽度
Call setDatareport(lst_selected, Dtreport, Trim$(txt_caption))
Dtreport.Show
Else
MsgBox "请选择要输出的字段条目", vbOKOnly + vbInformation
End If
End Sub
'***********************************************************************************
'Section1,Section2的keeptogther=true时,如果某条记录处在一页最下面,但又不完全能打印出来时,可强制将此条记录换到下一页打印。
'Rpttextbox、Rptlable和RptFunction中Gangrow=true时当显示的内容超过控件的宽度是可以换行。
'打印报表字段宽度控制子程序
Private Sub fieldwidth(lst As ListBox)
Dim i As Integer
Const wordwidth As Integer = 201 '五号字的宽带是201缇
For i = 0 To lst.ListCount - 1
Select Case lst.List(i)
Case "编号"
lst.ItemData(i) = wordwidth * 4
Case "名称"
lst.ItemData(i) = wordwidth * 12
Case "款号"
lst.ItemData(i) = wordwidth * 4
Case "规格"
lst.ItemData(i) = wordwidth * 3
Case "件数"
lst.ItemData(i) = wordwidth * 3
Case "重量g"
lst.ItemData(i) = wordwidth * 3
Case "单价类型"
lst.ItemData(i) = wordwidth * 4
Case "单价"
lst.ItemData(i) = wordwidth * 3
End Select
Next i
End Sub
'***********************************************************************************
'***********************************************************************************
'设置报表窗体各种参数,控制输出格式
Private Sub setDatareport(lst As ListBox, dtr As DataReport, scaption As String)
Dim leftpos As Long 'leftpos为存放控件left属性的变量
Dim reportwidth As Long 'reportwidth为存放DataReport总宽度的变量
Dim i As Integer
Dim Rst1 As New ADODB.Recordset '定义一个数据库记录对象
Dim SqlDef As String '定义字符串变量
'求总宽度
For i = 0 To lst.ListCount - 1
reportwidth = reportwidth + lst.ItemData(i)
Next i
'初始化
If VSFlexGrid1.Rows >= 1 Then dh1 = VSFlexGrid1.TextMatrix(VSFlexGrid1.RowSel, 1)
''''SqlDef = "select BH AS 编号,MC AS 名称,KH AS 款号,GG AS 规格,JS AS 件数,ZL AS 重量g,DJLX AS 单价类型," & _
'''' "DJ AS 单价,JE AS 金额,GFLX AS 工费类型,GF AS 工费,GFJE AS 工费金额,ZJE AS 总金额,SJ AS 售价,BZ AS 备注 from YSPF_ZC_PLRKDMX where DH='" & dh1 & "'"
SqlDef = "select BH AS 编号,MC AS 名称,KH AS 款号,GG AS 规格,JS AS 件数,ZL AS 重量g,DJLX AS 单价类型," & _
"DJ AS 单价 from YSPF_FD_RKDMX where DH='" & dh1 & "'"
Rst1.Open SqlDef, gConn, adOpenStatic, adLockReadOnly, -1 '进入数据库查询,并把查询结果赋值给rst记录对象
With dtr
'设置数据源,页边距、标题、横向分割线,section1.2区第一条竖向分割线
.LeftMargin = 1440
.RightMargin = 1440
.TopMargin = 1440
.BottomMargin = 144
'.reportwidth = Printer.With - 2880 - 20
Set .DataSource = Rst1 'Rst1为数据源
.Sections("Section4").Controls.Item("label1").Caption = scaption
.Sections("Section4").Controls.Item("label1").Width = reportwidth
.Sections("Section4").Controls.Item("label2").Width = reportwidth
.Sections("Section2").Controls.Item("line2").Width = reportwidth
.Sections("Section2").Controls.Item("line_2").Width = reportwidth
.Sections("Section1").Controls.Item("line1").Width = reportwidth
.Sections("Section2").Controls.Item("line20").Left = 0
.Sections("Section1").Controls.Item("line10").Left = 0
End With
'为section1,2区设置数据
leftpos = 0
For i = 0 To lst.ListCount - 1
dtr.Sections("Section2").Controls.Item("label1" & (i + 1)).Caption = lst.List(i)
dtr.Sections("Section2").Controls.Item("label1" & (i + 1)).Width = lst.ItemData(i)
dtr.Sections("Section2").Controls.Item("label1" & (i + 1)).Left = leftpos
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).DataField = lst.List(i)
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).Width = lst.ItemData(i)
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).Left = leftpos
dtr.Sections("Section1").Controls.Item("line1" & (i + 1)).Left = leftpos + lst.ItemData(i)
dtr.Sections("Section2").Controls.Item("line2" & (i + 1)).Left = leftpos + lst.ItemData(i)
leftpos = leftpos + lst.ItemData(i)
'特殊字体的格式特殊处理
If lst.List(i) = "收盘价" Then
dtr.Sections("Section1").Controls.Item("text1" & (i + 1)).DataFormat.Format = "#,##0"
End If
Next i
'对不用的text控件必须设置datafield属性,如lst.list(0),否则出错,但一定让其不可见
'其他不用的lable,line控件同样均不可见
i = lst.ListCount
While i < (dtr.Sections("Section1").Controls.Count - 10)
'10 为Section1区域的非text控件的控件总数
i = i + 1
dtr.Sections("Section1").Controls.Item("text1" & i).DataField = lst.List(1)
dtr.Sections("Section1").Controls.Item("text1" & i).Visible = False
dtr.Sections("Section1").Controls.Item("line1" & i).Visible = False
dtr.Sections("Section2").Controls.Item("line2" & i).Visible = False
dtr.Sections("Section2").Controls.Item("label1" & i).Visible = False
Wend
End Sub
'***********************************************************************************
Private Sub Command20_Click()
If lst_candidate.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
'如果lst_candidate中没有列表项则退出
If lst_candidate.ListIndex = -1 Then
lst_candidate.SetFocus
lst_candidate.Selected(0) = True
End If
'如果lst_candidate中没有选中的列表项则选择第一个列表项
DoEvents
lst_selected.AddItem lst_candidate.Text
lst_candidate.RemoveItem lst_candidate.ListIndex
End Sub
Private Sub Command21_Click()
If lst_selected.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
'如果lst_selected中没有列表项则退出
If lst_selected.ListIndex = -1 Then
lst_selected.SetFocus
lst_selected.Selected(0) = True
End If
'如果lst_selected中没有选中的列表项则选择第一个列表项
lst_candidate.AddItem lst_selected.Text
lst_selected.RemoveItem lst_selected.ListIndex
'将选择的列表项从lst_selected移到lst_candidate
End Sub
Private Sub Command22_Click()
If lst_candidate.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
'如果lst_candidate中没有列表项则退出
If lst_candidate.ListIndex = -1 Then
lst_candidate.SetFocus
lst_candidate.Selected(0) = True
End If
'如果lst_candidate中没有选中的列表项则选择第一个列表项
DoEvents
For i = (lst_candidate.ListCount - 1) To 0 Step -1
lst_selected.AddItem lst_candidate.List(i)
DoEvents
Next i
'将lst_candidate的所有列表项添加到lst_selected中
lst_candidate.Clear
'删除lst_candidate中的所有列表项
End Sub
Private Sub Command23_Click()
If lst_selected.ListCount = 0 Then
Screen.MousePointer = 0
Exit Sub
End If
If lst_selected.ListCount = 0 Then Exit Sub
If lst_selected.ListIndex = -1 Then
lst_selected.SetFocus
lst_selected.Selected(0) = True
End If
For i = (lst_selected.ListCount - 1) To 0 Step -1
lst_candidate.AddItem lst_selected.List(i)
DoEvents
Next i
lst_selected.Clear
End Sub