Exit Sub
ModifyERR:
  MsgBox "更新客戶卡內金額錯誤:" & Err.Description, vbCritical
  Exit Sub
   
End Sub

'更新客戶累計
Public Sub UpdateGuestLJ(DBTmp As Connection, smyID As String, curConsume As Currency, curArrearage As Currency)
 
  On Error GoTo ModifyERR
 
 '減少客戶押金
  Dim sgTmp As String
      sgTmp = "Update tbdMember Set DConsum=DConsum+" & curConsume & ",DArrearage=Darrearage+" & curArrearage & " Where ID='" & smyID & "'"
      DBTmp.Execute sgTmp
         
  Exit Sub
ModifyERR:
  MsgBox "更新客戶累計消費錯誤:" & Err.Description, vbCritical
  Exit Sub
  
End Sub

'插入到當日現金表中
Public Sub InserTodayCash(DBTmp As Connection, sTmpType As String, curMoney As Currency, bDate As Date)

 '沒有分類時不添加
  If sTmpType = "" Then Exit Sub
  
  On Error GoTo AddERR
  Dim CBRs As Recordset
  Set CBRs = CreateObject("ADODB.Recordset")
      If IsSqlDat = True Then
         CBRs.Open "Select * from tbdCash Where DType='" & sTmpType & "' And DDate='" & bDate & "'", DBTmp, adOpenStatic, adLockOptimistic, adCmdText
       Else
         CBRs.Open "Select * from tbdCash Where DType='" & sTmpType & "' And DDate=#" & bDate & "#", DBTmp, adOpenStatic, adLockOptimistic, adCmdText
      End If
      If CBRs.EOF And CBRs.BOF Then
        '每天第一張單據時
         CBRs.AddNew
         CBRs("DDate") = bDate
         CBRs("DType") = sTmpType
         CBRs("DNumber") = 1
         CBRs("DCash") = curMoney
        Else
        '數量添加，金額添加
         If curMoney < 0 Then
           '為負數量，表示還原或刪除時
            CBRs("DNumber") = CBRs("DNumber") - 1
          Else
            CBRs("DNumber") = CBRs("DNumber") + 1
         End If
         CBRs("DCash") = CBRs("DCash") + curMoney
       End If
       CBRs.Update
       CBRs.Close
       
  '同時一起更新現金總表中內容
       
   Exit Sub
AddERR:
   MsgBox "更新現金庫錯誤:" & Err.Description, vbCritical
   
End Sub

Public Sub ChangeIt(sFirstSite As String)

    On Error GoTo ERR_HZ
    Dim DB As Connection
    Dim EF As Recordset
    Dim lSheelID As Long
    Set DB = CreateObject("ADODB.Connection")
    Set EF = CreateObject("ADODB.Recordset")
    Dim sTMp As String
        DB.Open Constr
        EF.Open "Select * From tmpSite Where Site='" & sFirstSite & "'", DB, adOpenStatic, adLockReadOnly, adCmdText
       '首先檢測該座位有沒有上臺，如果沒有上臺將不能調換
        If EF.BOF And EF.EOF Then  '沒有記錄時為0
           EF.Close
           Set EF = Nothing
           DB.Close
           Set DB = Nothing
           MsgBox "對不起，【餐桌" & sFirstSite & "】沒有消費記錄！   " & vbCrLf & vbCrLf & "不能進行〖換桌〗請求！  ", vbInformation
           Exit Sub
        End If
           EF.Close
           Dim sNewSite As String
               sNewSite = Trim(InputBox("請輸入要換的桌號或座位號！   "))
           If sNewSite = "" Then
               DB.Close
               Set DB = Nothing
               'MsgBox "調換的桌號為空不能換桌！   ", vbInformation
               Exit Sub
           End If
          '如果一樣時
           If UCase(sNewSite) = UCase(sFirstSite) Then
               DB.Close
               Set DB = Nothing
               MsgBox "兩桌號一樣不能換桌,如何使得？   ", vbInformation
               Exit Sub
           End If
          '檢測該座位是否在使用
               EF.Open "Select * From SiteType Where Class='" & sNewSite & "'", DB, adOpenStatic, adLockReadOnly
               '檢測該座位是否有效
               If EF.BOF And EF.EOF Then '不存在時
                  EF.Close
                  Set EF = Nothing
                  DB.Close
                  Set DB = Nothing
                  MsgBox "該桌號沒有定義，不能換桌！   " & vbCrLf & vbCrLf & "請首先在【基本配置】中〖座位分類〗中添加桌號？   ", vbInformation
                  Exit Sub
                 Else
                   If EF("SiteStatus") = 2 Then
                     '上臺時，正在用餐
                      EF.Close
                      Set EF = Nothing
                      DB.Close
                      Set DB = Nothing
                      MsgBox "該桌正在用餐，不能換桌！   " & vbCrLf & vbCrLf & "調換必須為空閑座位（餐桌）？   ", vbInformation
                      Exit Sub
                   Else
                      EF.Close
                      Set EF = Nothing
                     '換桌動作
                      DB.BeginTrans
                     '更新
                      sTMp = "Update tmpSite Set Site='" & sNewSite & "' Where Site='" & sFirstSite & "'"
                      DB.Execute sTMp
                      sTMp = "Update tmpCust Set Site='" & sNewSite & "' Where Site='" & sFirstSite & "'"
                      DB.Execute sTMp
                     '恢復該座號的狀態
                      sTMp = "Update SiteType Set SiteStatus=0 Where Class='" & sFirstSite & "'"
                      DB.Execute sTMp
                     '修改調換后的狀態
                      sTMp = "Update SiteType Set SiteStatus=2 Where Class='" & sNewSite & "'"
                      DB.Execute sTMp
                      DB.CommitTrans
                      DB.Close
                      Set DB = Nothing
                      MsgBox "桌號已經更換，請到【客人上臺】區管理。    ", vbInformation
                   End If
               End If
           
        
               Exit Sub
ERR_HZ:
        MsgBox "對不起，換桌錯誤：   " & vbCrLf & vbCrLf & Err.Description, vbInformation
        Exit Sub
        
End Sub

Public Sub CopyIt(sFirstSite As String)

 On Error GoTo ERR_HZ
    Dim DB As Connection
    Dim EF As Recordset
    Dim lSheelID As Long
    Set DB = CreateObject("ADODB.Connection")
    Set EF = CreateObject("ADODB.Recordset")
        DB.Open Constr
        EF.Open "Select * From tmpSite Where Site='" & sFirstSite & "'", DB, adOpenStatic, adLockReadOnly, adCmdText
       '首先檢測該座位有沒有上臺，退出
        If EF.BOF And EF.EOF Then  '沒有記錄時為0
           EF.Close
           Set EF = Nothing
           DB.Close
           Set DB = Nothing
           MsgBox "對不起，沒有找到[" & sFirstSite & "]消費記錄單！   " & vbCrLf & vbCrLf & "不能進行【同桌】請求！  ", vbInformation
           Exit Sub
        End If
        EF.Close
        Set EF = Nothing
        DB.Close
        Set DB = Nothing
            sPubSite = sFirstSite  '桌號保存
           '顯示未消費的桌
            frmCopysite.Show 1
        Exit Sub
        
ERR_HZ:
        MsgBox "對不起，同桌復制錯誤：   " & vbCrLf & vbCrLf & Err.Description, vbInformation
        Exit Sub
End Sub

Public Function DeleteGoto(nID As Long) As Boolean

  On Error GoTo DelErr
  
  Dim bDB As Connection
  Dim sTMp As String
     
  If nID = 0 Then Exit Function
  
  If MsgBox("真要刪除[" & nID & "]號消費單嗎？（Y/N）  ", vbInformation + vbYesNo) = vbNo Then
     DeleteGoto = False
     Exit Function
  End If
 
       Set bDB = CreateObject("ADODB.Connection")
           bDB.Open Constr
           
           Dim FG As Recordset
           Dim lID As Long
           Dim IsGZ As Integer
           Dim curMoney As Currency           '金額
           Dim sMemberID As String            '如果為會員時,必須修改該會員的累計
           Dim sPaymethod As String
           Dim tmpCur As Currency

               curMoney = 0: sMemberID = "": IsGZ = 0
           
           Set FG = CreateObject("ADODB.Recordset")
             '打開該坐位的所有記錄
              FG.Open "Select * From Site Where ID=" & nID, bDB, adOpenStatic, adLockReadOnly, adCmdText
            '2沒有找到該座位的消費記錄
             If FG.EOF And FG.BOF Then '沒有記錄時
                FG.Close
                bDB.Close
                Set FG = Nothing
                Set bDB = Nothing
                MsgBox "對不起，沒有找到編號為【" & nID & "】消費單！  " & vbCrLf _
                   & "請確認是不是其他用戶已經刪除該單,請刷新再試試？   ", vbInformation
                Exit Function
               Else
                lID = FG.Fields("ID")            '給出該座位的最后一次消費的單號
                curMoney = FG("SFAmo")
                sMemberID = NullValue(FG("MID"))
                IsGZ = FG("IsArrearage")        '掛帳
                sPaymethod = NullValue(FG("tmpStr"))
                tmpCur = FG("tmpCur")
                FG.Close
              End If
              Set FG = Nothing
              
               bDB.BeginTrans
               
              '刪除單據明細與座位信息
               sTMp = "Delete From Site Where ID=" & lID
               bDB.Execute sTMp
               sTMp = "Delete From Cust Where SheelID=" & lID
               bDB.Execute sTMp
               
              '如果非掛帳時
               If IsGZ = 0 Then
                 '還原流水帳
                  If tmpCur = curMoney Then        '所有都以卡付時
                    If tmpCur > 0 Then
                       Dim tmpRemain As Currency
                           tmpRemain = GetCount(bDB, sMemberID) + tmpCur
                          '補充卡值
                           InserToCard bDB, 1, "『" & lID & "』號消費單還原" & Time, tmpCur, sMemberID, lID, tmpRemain
                           InserToCash bDB, 0, "消費單還原", tmpCur, Date, sPaymethod
                          '修改今日與總金額
                           InserTodayCash bDB, "會員卡付", -tmpCur, Date
                          '更新最后余額
                           UpdateRemain bDB, sMemberID, tmpRemain
                    End If
                   Else                           '卡與其它合用時
                    If tmpCur > 0 Then
                        InserToCash bDB, 0, "消費單還原", curMoney - tmpCur, Date, sPaymethod
                        InserTodayCash bDB, sPaymethod, -(curMoney - tmpCur), Date
                        InserToCard bDB, 1, "『" & lID & "』號消費單還原" & Time, tmpCur, sMemberID, lID, tmpRemain
                        InserTodayCash bDB, "會員卡付", -tmpCur, Date
                        InserToCash bDB, 0, "消費單還原", tmpCur, Date, "會員卡付"
                      Else
                      '不使用卡時
                        InserToCash bDB, 0, "消費單還原", curMoney, Date, sPaymethod
                        InserTodayCash bDB, sPaymethod, -curMoney, Date
                     End If
                  End If
                 '如果客戶不為空時
                  If sMemberID <> "" Then
                     UpdateGuestLJ bDB, sMemberID, -curMoney, 0
                  End If
                Else
                '掛帳時
                 If sMemberID <> "" Then
                    UpdateGuestLJ bDB, sMemberID, 0, -curMoney
                 End If
               '修改掛帳中金額及付款日期
                'sTmp = "Update tbdArrearage Set MSFAmount=" & curMoney & ",MReturn=1,MRDate=#" & Date & "# Where SheelID=" & lID
                '直接刪除消費單
                 sTMp = "Delete tbdArrearage Where SheelID=" & lID
                 bDB.Execute sTMp
               End If
               
              bDB.CommitTrans
              bDB.Close
          Set bDB = Nothing
          DeleteGoto = True
          
          Exit Function
DelErr:
          MsgBox "刪除消費單錯誤:" & Err.Description, vbCritical
          DeleteGoto = False
          
End Function

'給出產品編號，不重復
Public Function GetNewNo(sType As String) As String
  
  On Error GoTo GetnoERR
  
  Dim noDB As Connection
  Dim noRS As Recordset
  Dim tmpString As String
   
  Set noDB = CreateObject("ADODB.Connection")
  Set noRS = CreateObject("ADODB.Recordset")
      noDB.Open Constr
      tmpString = "Select * from tbdFileSheel Where Sheeltype='" & sType & "'"
      noRS.Open tmpString, noDB, adOpenStatic, adLockReadOnly, adCmdText
      If Not (noRS.EOF And noRS.BOF) Then
         GetNewNo = noRS("SheelID") + 1
         Select Case Len(GetNewNo)
          Case 1
            GetNewNo = "0000" & GetNewNo
          Case 2
            GetNewNo = "000" & GetNewNo
          Case 3
            GetNewNo = "00" & GetNewNo
          Case 4
            GetNewNo = "0" & GetNewNo
          Case Else
          End Select
        Else
         GetNewNo = ""
      End If
  
  noRS.Close
  noDB.Close
  Set noRS = Nothing
  Set noDB = Nothing
  
  Exit Function
GetnoERR:
  GetNewNo = ""
  
End Function

'更新會員或產品總數
Public Sub SaveNewNo(sType As String, TmpDB As Connection)

  On Error GoTo GetnoERR
  
  Dim tmpString As String
      tmpString = "Update tbdFileSheel Set SheelID=SheelID+1 Where Sheeltype='" & sType & "'"
      TmpDB.Execute tmpString
  
  Exit Sub
GetnoERR:
  MsgBox "更新單號錯誤:" & Err.Description, vbCritical
  
End Sub

'通過類型，給出固定的ID號
Public Function GetFixNo(sType As String)

  On Error GoTo UpdateNOErr:
  
  Dim DFF As Connection
  Dim EFF As Recordset
  Dim nNO As Long
  Dim sYear As String, sMonth As String, sDate As String, sNO As String
  
  Set DFF = CreateObject("ADODB.Connection")
      DFF.Open Constr
  Set EFF = CreateObject("ADODB.Recordset")
       
      If IsSqlDat = True Then
         EFF.Open "Select * from tbdSheel Where SheelDate='2002-07-19' and SheelType='" & sType & "'", DFF, adOpenStatic, adLockOptimistic, adCmdText
      Else
         EFF.Open "Select * from tbdSheel Where SheelDate=#2002-07-19# and SheelType='" & sType & "'", DFF, adOpenStatic, adLockOptimistic, adCmdText
      End If
      
  If EFF.EOF And EFF.BOF Then
     EFF.AddNew
     EFF("SheelDate") = "2002-07-19"
     EFF("sheelType") = sType
     EFF("SheelNO") = 1
     EFF.Update
     nNO = 1
    Else
     nNO = EFF.Fields("SheelNO") + 1
     EFF("SheelNO") = nNO
     EFF.Update
  End If
      EFF.Close
  Set EFF = Nothing
      DFF.Close
  Set DFF = Nothing
     
 '給出數字
  GetFixNo = Trim(str(nNO))
  
  Exit Function
UpdateNOErr:
  MsgBox "給出FIX單號錯誤：" & Err.Description, vbCritical
  GetFixNo = 1
  
End Function