?? frmstatuspay.frm
字號:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form FrmStatusPay
Caption = "實收房款統計"
ClientHeight = 4995
ClientLeft = 60
ClientTop = 450
ClientWidth = 7050
LinkTopic = "Form1"
ScaleHeight = 4995
ScaleWidth = 7050
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "導出"
Height = 495
Left = 3840
TabIndex = 5
Top = 4200
Width = 1215
End
Begin VB.TextBox txtDate
Height = 270
Left = 1200
TabIndex = 2
Top = 52
Width = 1095
End
Begin VB.CommandButton Cmd_Search
Caption = "查 詢"
Height = 375
Left = 3840
TabIndex = 1
Top = 0
Width = 975
End
Begin VB.CommandButton Cmd_Close
Caption = "關 閉"
Height = 495
Left = 2040
TabIndex = 0
Top = 4200
Width = 1215
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 240
Top = 4147
Visible = 0 'False
Width = 1935
_ExtentX = 3413
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSDataGridLib.DataGrid DataGrid1
Bindings = "FrmStatusPay.frx":0000
Height = 3375
Left = 0
TabIndex = 3
Top = 547
Width = 6855
_ExtentX = 12091
_ExtentY = 5953
_Version = 393216
HeadLines = 1
RowHeight = 15
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "收款日期："
Height = 180
Left = 120
TabIndex = 4
Top = 90
Width = 900
End
End
Attribute VB_Name = "FrmStatusPay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private DataConn As New ADODB.Connection
Private DataRec As New ADODB.Recordset
Private DataCmd As New ADODB.Command
Private Sub Refresh_Pay()
Dim strSearch As String
If Trim(txtDate) <> "" Then
strSearch = " WHERE OptTime='" + Trim(txtDate.Text) + "'"
End If
'設置記錄源
Adodc1.ConnectionString = Conn
'Adodc1.RecordSource = "SELECT OptTime As 收費日期, Sum(Amount) As 收費總金額" _
' + " FROM PayforRoom" + strSearch + " GROUP BY OptTime"
Adodc1.RecordSource = "SELECT RegId as 編號,OptTime As 收費日期, Amount As 收費金額,UserName as 經辦人" _
+ " FROM PayforRoom" + strSearch
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Columns(0).Width = 1000
DataGrid1.Columns(1).Width = 1500
DataGrid1.Columns(2).Width = 1500
DataGrid1.Columns(3).Width = 1500
End Sub
Private Sub Cmd_Close_Click()
Unload Me
End Sub
'查詢客戶消費信息
Private Sub Cmd_Search_Click()
Refresh_Pay
Print_E
Insert
End Sub
Private Sub Command2_Click()
Call ExporToExcel
End Sub
Private Sub Form_Load()
Refresh_Pay
End Sub
Public Sub Print_E()
SqlStmt = "DELETE FROM DZ"
SQLExt (SqlStmt)
End Sub
Public Sub Insert()
Dim strID As String
Dim strDate As String
Dim strAmount As String
Dim strName As String
While (Not (Adodc1.Recordset.EOF))
strID = Adodc1.Recordset.Fields("編號").Value
strDate = Adodc1.Recordset.Fields("收費日期").Value
strAmount = Adodc1.Recordset.Fields("收費金額").Value
strName = Adodc1.Recordset.Fields("經辦人").Value
SqlStmt = "insert into DZ(CostId,OptTime,Amount,UserName) values('" + strID + "','" + strDate + "'," + strAmount + ",'" + strName + "')"
SQLExt (SqlStmt)
Adodc1.Recordset.MoveNext
Wend
End Sub
Public Sub ExporToExcel()
'建立一個ADO數據連接
Dim DataConn As New ADODB.Connection
Dim DataRec As New ADODB.Recordset
Dim strSQL As String
'若數據庫連接出錯，則轉向ConnectionERR
On Error GoTo ConnectionERR
'建立一個連接字串
'這個連接串可能根據數據庫配置的不同而不同
DataConn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;;Persist Security Info=False;Initial Catalog=Hotel;Data Source=114EF334F637425"
'建立數據庫連接
DataConn.Open
'若RecordSet建立出錯，則轉向RecordsetERR
On Error GoTo RecordSetERR
strSQL = "SELECT * "
'從表authors查詢
strSQL = strSQL & "FROM DZ"
Dim lngRowCount As Integer
Dim lngColCount As Integer
Dim ExcelAppX As Excel.Application
Dim ExcelBookX As Excel.Workbook
Dim ExcelSheetX As Excel.Worksheet
Dim ExcelQueryX As Excel.QueryTable
With DataRec
If .State = adStateOpen Then
.Close
End If
.ActiveConnection = DataConn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = strSQL
.Open
End With
With DataRec
If .RecordCount < 1 Then
Call MsgBox("沒有記錄!", vbExclamation, "錯誤")
Exit Sub
End If
'記錄總數
lngRowCount = .RecordCount
'字段總數
lngColCount = .Fields.Count
End With
On Error GoTo ExcelERR
'建立Excel應用程序
Set ExcelAppX = CreateObject("Excel.Application")
'建立WorkBook
Set ExcelBookX = ExcelAppX.Workbooks().Add(App.Path & "\authors.xlsx")
'建立表格sheet1
Set ExcelSheetX = ExcelBookX.Worksheets("sheet1")
ExcelAppX.Visible = True
'添加查詢，填充Excel表格
'注意此句?。。? '從A3處向右下填充表格
Set ExcelQueryX = ExcelSheetX.QueryTables.Add(DataRec, ExcelSheetX.Range("A3"))
'查詢設置
With ExcelQueryX
'是否顯示字段名
.FieldNames = False
'是否顯示行號
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
'后臺搜索
.BackgroundQuery = True
'刷新樣式
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
'是否保存數據
.SaveData = True
'是否自動調整列寬度
.AdjustColumnWidth = False
'自動刷新間距，設置為0是關閉自動刷新
.RefreshPeriod = 0
.PreserveColumnInfo = True
End With
'進行查詢
ExcelQueryX.Refresh
'設置字體和表格屬性
With ExcelSheetX
.Range(.Cells(1, 1), .Cells(lngRowCount + 2, lngColCount)).Borders.LineStyle = xlContinuous
'設表格邊框樣式
End With
'設置打印信息
' With ExcelSheetX.PageSetup
' .LeftHeader = "&""楷體_GB2312,常規""&10公司名稱："
' .CenterHeader = "&""楷體_GB2312,常規""&10日期："
' .RightHeader = "&""楷體_GB2312,常規""&10單位："
' .LeftFooter = "&""楷體_GB2312,常規""&10制表人："
' .CenterFooter = "&""楷體_GB2312,常規""&10制表日期：" & Date
' .RightFooter = "&""楷體_GB2312,常規""&10第&P頁 共&N頁"
' End With
ExcelAppX.Application.Visible = True
ExcelSheetX.PrintPreview
ExcelAppX.DisplayAlerts = False
ExcelAppX.Quit
Set ExcelAppX = Nothing '"交還控制給Excel
Set ExcelBookX = Nothing
Set ExcelSheetX = Nothing
Exit Sub
ConnectionERR:
'錯誤處理程序
MsgBox "數據庫連接錯誤，" & Err.Description, vbCritical, "出錯"
Exit Sub
RecordSetERR:
MsgBox "RecordSet生成錯誤，" & Err.Description, vbCritical, "出錯"
DataConn.Close
Exit Sub
ExcelERR:
MsgBox "填充Excel表格錯誤，" & Err.Description, vbCritical, "出錯"
If Not ExcelAppX Is Nothing Then ExcelAppX.Quit
DataRec.Close
DataConn.Close
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -