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 FrmEatPay 
   Caption         =   "實收餐款統計"
   ClientHeight    =   4800
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8115
   LinkTopic       =   "Form1"
   ScaleHeight     =   4800
   ScaleWidth      =   8115
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "導出"
      Height          =   495
      Left            =   4560
      TabIndex        =   5
      Top             =   4200
      Width           =   1335
   End
   Begin VB.CommandButton Cmd_Search 
      Caption         =   "查 詢"
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   75
      Width           =   975
   End
   Begin VB.TextBox txtDate 
      Height          =   270
      Left            =   1320
      TabIndex        =   2
      Top             =   120
      Width           =   1095
   End
   Begin VB.CommandButton Cmd_Close 
      Caption         =   "關 閉"
      Height          =   495
      Left            =   2820
      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 
      Height          =   3375
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   7815
      _ExtentX        =   13785
      _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            =   240
      TabIndex        =   4
      Top             =   165
      Width           =   900
   End
End
Attribute VB_Name = "FrmEatPay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Refresh_Pay()
  '設置記錄源
    Dim strSearch As String
  If Trim(txtDate) <> "" Then
    strSearch = " and CostTime='" + Trim(txtDate.Text) + "'"
    End If
  Adodc1.ConnectionString = Conn
  'Adodc1.RecordSource = "SELECT CostTime As 收費日期, Sum(CostMoney) As 收費總金額" _
            + " FROM Eat_Cost  where Status = 1 " + strSearch + " GROUP BY CostTime"
  Adodc1.RecordSource = "SELECT CostID as 編號, CostTime As 收費日期, CostMoney As 收費金額, UserName As 經辦人" _
            + " FROM Eat_Cost  where Status = 1 " + strSearch
  Adodc1.Refresh
  Set DataGrid1.DataSource = Adodc1
  DataGrid1.Columns(0).Width = 2000
  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_P_Click()
DataReport1.Show 1
End Sub

'查詢客戶消費信息
Private Sub Cmd_Search_Click()
  Refresh_Pay
  Print_E
  Insert
End Sub

Private Sub Command1_Click()
Call ExporToExcel
End Sub



Private Sub Form_Load()
  Refresh_Pay

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 Print_E()
  SqlStmt = "DELETE FROM DZ"
  SQLExt (SqlStmt)
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