📄 formhfjl.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FormHFJL
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 8055
ClientLeft = 45
ClientTop = 435
ClientWidth = 10920
BeginProperty Font
Name = "Tahoma"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8055
ScaleWidth = 10920
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox picLOAD
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 375
Left = 120
ScaleHeight = 345
ScaleWidth = 2985
TabIndex = 10
Top = 960
Visible = 0 'False
Width = 3015
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 135
Left = 120
TabIndex = 11
Top = 120
Width = 2775
_ExtentX = 4895
_ExtentY = 238
_Version = 393216
Appearance = 0
End
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 855
Left = 0
ScaleHeight = 855
ScaleWidth = 10935
TabIndex = 7
Top = 0
Width = 10935
End
Begin VB.ComboBox comXM
Height = 330
Left = 4200
TabIndex = 5
Top = 960
Width = 1575
End
Begin VB.CommandButton cmdCZ
Caption = "查找(&S)"
Height = 340
Left = 8040
TabIndex = 4
Top = 960
Width = 855
End
Begin VB.CommandButton cmdQC
Caption = "清除(&R)"
Height = 340
Left = 9000
TabIndex = 3
Top = 960
Width = 855
End
Begin VB.CommandButton cmdXLS
Caption = "导出(&E)"
Height = 340
Left = 9960
TabIndex = 2
Top = 960
Width = 855
End
Begin VB.TextBox txtCZ
Height = 320
Left = 6360
TabIndex = 1
Top = 960
Width = 1455
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 0
Top = 7800
Width = 10920
_ExtentX = 19262
_ExtentY = 450
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 19209
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ImageList1
Left = 9960
Top = 240
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FormHFJL.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FormHFJL.frx":0114
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ListView ListView1
Height = 6375
Left = 0
TabIndex = 6
Top = 1440
Width = 10935
_ExtentX = 19288
_ExtentY = 11245
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 0
NumItems = 0
End
Begin VB.Label label1
Caption = "项目"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 9
Top = 1035
Width = 375
End
Begin VB.Label Label2
Caption = "查找"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 5880
TabIndex = 8
Top = 1035
Width = 495
End
End
Attribute VB_Name = "FormHFJL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim addlist1 As ListItem
Private Sub cmdCZ_Click()
ListView1.ListItems.Clear
Call addXX
End Sub
Private Sub cmdQC_Click()
Me.comXM.Text = ""
txtCZ.Text = ""
ListView1.ListItems.Clear
Call addXX
End Sub
Private Sub cmdXLS_Click()
k = 0
picLOAD.Visible = True
Call OpenConn
If comXM.Text = "" Or txtCZ.Text = "" Then
sql = "select * from hfb ORDER BY hfid"
Else
Dim xmmc As String '项目名称
If Me.comXM.Text = "回访单号" Then xmmc = "hfid"
If Me.comXM.Text = "产品评价" Then xmmc = "cppj"
If Me.comXM.Text = "服务评价" Then xmmc = "fwpj"
If Me.comXM.Text = "回访人" Then xmmc = "hfr"
If Me.comXM.Text = "回访日期" Then xmmc = "hfrq"
sql = "select * from hfb where " & xmmc & " like '%" & txtCZ.Text & "%' ORDER BY hfid"
End If
rs.Open sql, cn, 1, 1
If rs.RecordCount <= 0 Then
MsgBox "没有可以导出的记录！", 48, "错误提示"
Exit Sub
Else
Call OpenExcel
'添加excel列头~~~~~~~~~~~~~~~~~~~~~~~
mysheet.Cells(1, 1) = "回访记录"
mysheet.Cells(2, 1) = "回访单号"
mysheet.Cells(2, 2) = "使用情况"
mysheet.Cells(2, 3) = "产品评价"
mysheet.Cells(2, 4) = "服务评价"
mysheet.Cells(2, 5) = "用户建议"
mysheet.Cells(2, 6) = "回访人"
mysheet.Cells(2, 7) = "回访日期"
mysheet.Cells(2, 8) = "用户编号"
j = 3
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
mysheet.Cells(j, i + 1) = rs.Fields(i).Value
Next i
j = j + 1
rs.MoveNext
k = k + 1
Me.ProgressBar1.Value = Format(k / rs.RecordCount, "0.00") * 100
Loop
End If
picLOAD.Visible = False
ProgressBar1.Value = 0
myexcel.Visible = True
Call CloseConn
Call CloseExcel
End Sub
Private Sub Form_Load()
Me.Icon = FormZY.Icon
Me.Caption = xtmc
Me.Picture1.Picture = LoadPicture(App.Path & "\bg\bg7.bmp")
comXM.AddItem "回访单号"
comXM.AddItem "产品评价"
comXM.AddItem "服务评价"
comXM.AddItem "回访人"
comXM.AddItem "回访日期"
'添加listview1标头、宽度~~~~~~~~~~~~~~~~~~~~~`
With ListView1
.View = lvwReport
.ColumnHeaders.Add = "回访单号"
.ColumnHeaders.Add = "使用情况"
.ColumnHeaders.Add = "产品评价"
.ColumnHeaders.Add = "服务评价"
.ColumnHeaders.Add = "用户建议"
.ColumnHeaders.Add = "回访人"
.ColumnHeaders.Add = "回访日期"
.ColumnHeaders.Add = "" '存放用户ID
.ColumnHeaders(2).Width = 3000
.ColumnHeaders(3).Width = 1000
.ColumnHeaders(4).Width = 1000
.ColumnHeaders(5).Width = 3000
.ColumnHeaders(8).Width = 0
End With
'添加listview1数据~~~~~~~~~~~~~~~~~~~~~~
Call addXX
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With ListView1 '点击列标头排序~~~~~~~~~~~~~~~~~~~~~
If (ColumnHeader.Index - 1) = .SortKey Then
.SortOrder = (.SortOrder + 1) Mod 2
Else
.Sorted = False
.SortOrder = 0
.SortKey = ColumnHeader.Index - 1
.Sorted = True
End If
End With
End Sub
Private Sub addXX()
'添加listview1数据~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
If comXM.Text = "" Or txtCZ.Text = "" Then
sql = "select * from hfb ORDER BY hfid"
Else
Dim xmmc As String '项目名称
If Me.comXM.Text = "回访单号" Then xmmc = "hfid"
If Me.comXM.Text = "产品评价" Then xmmc = "cppj"
If Me.comXM.Text = "服务评价" Then xmmc = "fwpj"
If Me.comXM.Text = "回访人" Then xmmc = "hfr"
If Me.comXM.Text = "回访日期" Then xmmc = "hfrq"
sql = "select * from hfb where " & xmmc & " like '%" & txtCZ.Text & "%' ORDER BY hfid"
End If
rs.Open sql, cn, 1, 1
Do While Not rs.EOF
Set addlist1 = ListView1.ListItems.Add(, , rs.Fields("hfid"), , 2) '将各项数据加入list列表
addlist1.SubItems(1) = IIf(IsNull(rs.Fields("syqk")), "", rs.Fields("syqk"))
addlist1.SubItems(2) = IIf(IsNull(rs.Fields("cppj")), "", rs.Fields("cppj"))
addlist1.SubItems(3) = IIf(IsNull(rs.Fields("fwpj")), "", rs.Fields("fwpj"))
addlist1.SubItems(4) = IIf(IsNull(rs.Fields("yhjy")), "", rs.Fields("yhjy"))
addlist1.SubItems(5) = IIf(IsNull(rs.Fields("hfr")), "", rs.Fields("hfr"))
addlist1.SubItems(6) = IIf(IsNull(rs.Fields("hfrq")), "", rs.Fields("hfrq"))
addlist1.SubItems(7) = IIf(IsNull(rs.Fields("hyhid")), "", rs.Fields("hyhid")) '传递用户ID
rs.MoveNext
Loop
Me.StatusBar1.Panels(1) = " 共有 " & rs.RecordCount & " 条记录被找到！"
Call CloseConn
End Sub
Private Sub ListView1_DblClick()
If ListView1.ListItems.Count <= 0 Then Exit Sub
yhxhcd = ListView1.SelectedItem.SubItems(7)
FormYHXX.Show 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -