EndProperty
         EndProperty
      End
      Begin VB.PictureBox Picture2 
         Height          =   0
         Left            =   0
         ScaleHeight     =   0
         ScaleWidth      =   0
         TabIndex        =   7
         Top             =   0
         Width           =   0
      End
   End
   Begin VB.Label Label2 
      Caption         =   "開始日期："
      ForeColor       =   &H00C00000&
      Height          =   180
      Index           =   0
      Left            =   3360
      TabIndex        =   5
      Top             =   405
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "截止日期："
      ForeColor       =   &H00C00000&
      Height          =   180
      Index           =   1
      Left            =   6360
      TabIndex        =   4
      Top             =   420
      Width           =   975
   End
End
Attribute VB_Name = "frm_Rpt_holiday"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Dim strSQL As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String

Private adoprimaryRS   As ADODB.Recordset
Private adoPrimaryRS2  As ADODB.Recordset
Private adoPrimaryRS3  As ADODB.Recordset
Private adoprimaryRS4  As ADODB.Recordset

Dim mDB As mDB





Private Sub datagrid1_HeadClick(ByVal intColIndex As Integer)
    '   'Sort by clicked column
    '   With adoprimaryRS
    '     .Sort = .Fields(ColIndex).Name & " ASC"
    '   End With
    '   DataGrid1.Refresh
    Static px As Integer
    px = px + 1
    'Sort by clicked column
    With adoprimaryRS
        If px Mod 2 = 0 Then
            .Sort = .Fields(intColIndex).Name & " ASC"
        Else
            .Sort = .Fields(intColIndex).Name & " DESC"
        End If
    
    End With
    DataGrid1.Refresh



End Sub

Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeys "{tab}"
    End If

End Sub

Private Sub Reload_Datalist()
'    'Dim DmDB As New mDB
'    'DmDB.InitDB_SQL "Zjxy", "xinya", "reformer", "5148936"
'    strSQL = "select * from E_TblCL"
'    Set adoprimaryRS = DmDB.adoprimaryRS(strSQL)
'    Debug.Print adoprimaryRS.RecordCount
'    With DataList1
'        Set .RowSource = adoprimaryRS
'        .BoundColumn = "tblID"
'        .ListField = "tblMC"
'        .ReFill
'    End With
'    'Set DmDB = Nothing

End Sub
'''''''''''''=======================================================================

Private Sub DataGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Index As Integer
    Dim yRow As Integer
    Dim sTmp
    On Error Resume Next

    Index = DataGrid1.ColContaining(X)
    yRow = DataGrid1.RowContaining(Y)


    If Button = vbRightButton Then
        Dim ltmp As Long
        'ltmp = oMenu.PopUp("過濾", "=過濾", "like過濾條件", "3列過濾", "2列過濾")
        'ltmp = oMenu.Popup("過濾", "like過濾條件", "2列過濾", "3列過濾", ">", "<", "-", "收發明細（按訂單）")
        ltmp = oMenu.Popup("like過濾條件", "刪除記錄")
        Dim Scode As String
        Dim iTmp As Single


        Select Case ltmp
            Case 1

                'adoPrimaryRS4.Filter = DataGrid1.Columns(Index).Caption & "='" & DataGrid1.Columns(Index).Text & "'"
                '
                'Case 2
                '''''''''''''==================
                sTmp = InputBox("請輸入過濾條件。", "NewAsia")
                If Len(sTmp) Then
                    adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & " like '" & sTmp & "%'"
                End If

                'ElseIf ltmp = 4 Then
                '
                'adoPrimaryRS2.Filter = DataGrid1.Columns(index - 1).Caption & "='" & DataGrid1.Columns(index - 1).Text & "' and " & DataGrid1.Columns(index).Caption & "='" & DataGrid1.Columns(index).Text & "' and " & DataGrid1.Columns(index + 1).Caption & "='" & DataGrid1.Columns(index + 1).Text & "'"
                '
                'ElseIf ltmp = 5 Then
                '
                'adoPrimaryRS2.Filter = DataGrid1.Columns(index).Caption & "='" & DataGrid1.Columns(index).Text & "' and " & DataGrid1.Columns(index + 1).Caption & "='" & DataGrid1.Columns(index + 1).Text & "'"
            Case 2
                If MsgBox("確實要刪除此條記錄嗎？(" & DataGrid1.Columns(1).Text & ")", vbYesNo, "提示：") = vbYes Then
    Select Case List1.ListIndex + 1
        Case 1
        strSQL = "Delete from holidayreg where ID=" & DataGrid1.Columns(0).Text
        mDB.ExecuteSQL strSQL
        
        Case 2
        strSQL = "Delete from evectionreg where ID=" & DataGrid1.Columns(0).Text
        mDB.ExecuteSQL strSQL
    End Select
                List1_Click
                
                End If
            Case 3
                adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & "='" & DataGrid1.Columns(Index).Text & "' and " & DataGrid1.Columns(Index + 1).Caption & "='" & DataGrid1.Columns(Index + 1).Text & "'"

            Case 4

                adoprimaryRS.Filter = DataGrid1.Columns(Index - 1).Caption & "='" & DataGrid1.Columns(Index - 1).Text & "' and " & DataGrid1.Columns(Index).Caption & "='" & DataGrid1.Columns(Index).Text & "' and " & DataGrid1.Columns(Index + 1).Caption & "='" & DataGrid1.Columns(Index + 1).Text & "'"

            Case 5
                'Dim iTmp As Integer
                iTmp = InputBox("請輸入過濾的數字：", "范圍過濾：", 0, X, Y)

                adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & ">=" & iTmp     ''''  sMan & "' or " & DataGrid1.Columns(4).Caption & "= '" & sMan & "'"
            Case 6
                iTmp = InputBox("請輸入過濾的數字：", "范圍過濾：", 0, X, Y)

                adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & "<" & iTmp     ''''  sMan & "' or " & DataGrid1.Columns(4).Caption & "= '" & sMan & "'"
            Case 8
                'DataCombo1.Text = DataGrid1.Columns(0).Text
                'Command1_Click 0
                'DataCombo1.Text = ""

        End Select

        'If ltmp > 0 And ltmp < 7 Then
        'Text1(4).Text = Sum_RsFld(adoPrimaryRS4, "收")
        'Text1(5).Text = Sum_RsFld(adoPrimaryRS4, "過程余量")
        'End If

    End If
End Sub

Private Sub List1_Click()
    'On Error Resume Next

    Select Case List1.ListIndex + 1
        Case 1
'            strSQL = "select a.ID as 序號,a.emplyid as 工號,emplyname as 姓名,holidaydecs as 請假類型,bgndatetime as 開始時間,enddatetime as 結束時間,hours as 請假工時,ratifier as 批準人,makeid as 登記,makedate as 制單時間,(case when isday<>0 then '整天' else '' end) as 是否整天,bzsm as 備注 from holidayreg a,emply b,holidaykind c where a.emplyid=b.emplyid and a.holidayid=c.holidayid and makedate >='" & DTPicker1(0).Value & "' and bgndatetime<'" & DTPicker1(1).Value + 1 & "'"
'            strSQL = "select a.ID as 序號,a.emplyid as 工號,emplyname as 姓名,holidaydecs as 請假類型,bgndatetime as 開始時間,enddatetime as 結束時間,hours as 請假工時,ratifier as 批準人,makeid as 登記,(case when isday<>0 then '整天' else '' end) as 是否整天,bzsm as 備注 from holidayreg a,emply b,holidaykind c where a.emplyid=b.emplyid and a.holidayid=c.holidayid and bgndatetime >='" & DTPicker1(0).Value & "' and bgndatetime<'" & DTPicker1(1).Value + 1 & "'"
            strSQL = "select a.ID as 序號,a.emplyid as 工號,emplyname as 姓名,dptname as 所屬部門,holidaydecs as 請假類型,bgndatetime as 開始時間,enddatetime as 結束時間,hours as 請假工時,ratifier as 批準人,makeid as 登記,(case when isday<>0 then '整天' else '' end) as 是否整天,bzsm as 備注 from holidayreg a,emply b,holidaykind c,depart d where b.dptid=d.dptid and a.emplyid=b.emplyid and a.holidayid=c.holidayid and bgndatetime >='" & DTPicker1(0).Value & "' and bgndatetime<'" & DTPicker1(1).Value + 1 & "'"
        Case 2
'            strSQL = "select a.ID as 序號, a.emplyid as 工號,emplyname as 姓名,evectiondecs as 出差類型,bgndatetime as 開始時間,enddatetime as 結束時間,hours as 出差工時,ratifier as 批準人,makeid as 登記,makedate as 制單時間,(case when isday<>0 then '整天' else '' end) as 是否整天,bzsm as 備注 from evectionreg a,emply b,evectionkind c where a.emplyid=b.emplyid and a.evectionid=c.evectionid and bgndatetime >='" & DTPicker1(0).Value & "' and bgndatetime <'" & DTPicker1(1).Value + 1 & "'"
            strSQL = "select a.ID as 序號, a.emplyid as 工號,emplyname as 姓名,dptname as 所屬部門,evectiondecs as 出差類型,bgndatetime as 開始時間,enddatetime as 結束時間,hours as 出差工時,ratifier as 批準人,makeid as 登記,(case when isday<>0 then '整天' else '' end) as 是否整天,bzsm as 備注 from evectionreg a,emply b,evectionkind c,depart d where b.dptid=d.dptid and a.emplyid=b.emplyid and a.evectionid=c.evectionid and bgndatetime >='" & DTPicker1(0).Value & "' and bgndatetime <'" & DTPicker1(1).Value + 1 & "'"

    End Select
'Debug.Print strSQL

    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    With DataGrid1
        .ClearFields
        Set .DataSource = adoprimaryRS
'            .Columns(0).width = 0
'            .Columns(1).width = 0
'            .Columns(2).width = 0
'            .Columns(3).width = 2000
            
            .AllowAddNew = False
            .AllowDelete = False
        .Refresh
    End With

End Sub

Private Sub Form_Load()
    Set mDB = New mDB
    Debug.Print SQLConnDR
    
    mDB.InitDB_RY SQLConnDR

   
    With List1
        .AddItem "員工請假信息統計"
        .AddItem "員工出差信息統計"
'        .AddItem "費用類型"
'        .AddItem "用車部門維護"
'        .AddItem "移動電話EMAIL登記"
'        .AddItem "檔案類別表"
'        .AddItem "檔案來源表"
'        .AddItem "存放地點表"
        .Refresh
    End With
    
    Me.Move 0, 0, width00 - 80, height00 - 80
    DTPicker1(0).Value = DateSerial(Year(Date), Month(Date), 1)
    DTPicker1(1).Value = Date


End Sub


Private Sub Form_Resize()
    On Error Resume Next
    With Me
        List1.Move 120, 700, 3000, .ScaleHeight - 840
        DataGrid1.Move 3100, 700, Me.width - 3500, ScaleHeight - 840
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'DataList1.SetFocus
    mDB.KillDB
    Set mDB = Nothing

End Sub



    ''''=======================================================


Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo Err1

Select Case Button.Index
Case 1

ToExcel.ToExcel adoprimaryRS
'ToExcel.ToExcel_noFld adoprimaryRS, "A1"

'ToExcel.ToExcelFlds adoprimaryRS, "部門名稱,經理工號,經理,郵箱,電話,地址"

Case 2
Unload Me


End Select

Exit Sub
Err1:
' MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & Err.Source & vbCrLf & Err.LastDllError & vbCrLf & Err.HelpContext, vbInformation, App.Title & "  -  Advisory"
DisPlayErr Err


End Sub