Création de base de donnée pour la gestion des salles et clients en VBA

Bonsoir à tous,

Je veux créer une base de gestion des salles et clients. cette base permettra de gérer les entrées et sorties des clients et la gestion des salles.

dans la base j'ai trois formulaire à savoir:

- le formulaire de saisie des entrées de client et occupation des salles contenant les codes suivant

pour ajouter le client dans les différent tableau du fichier

Private Sub BtnAjoutEntree_Click()

    Dim I As Integer
    Sheets("LISTE_OCCU_SALLE").Activate
       For I = 2 To Range("A:A").End(xlDown).Row

             If Cells(I, 1).Text = CboSalle.Text Then
                MsgBox "Cette salle est déjà occupé par " & Cells(I, 3).Text: CboSalle = "": CboSalle.SetFocus: Exit Sub
           End If
      Next I

           TxtNomClient.SetFocus
           [A65536].End(xlUp).Offset(1, 0).Select
           Cells(ActiveCell.Row, 1) = CboSalle.Text
           Cells(ActiveCell.Row, 2) = TxtIntituleSalle.Text
           Cells(ActiveCell.Row, 3) = TxtNomClient.Text
           Cells(ActiveCell.Row, 4) = TxtAdresseClient.Text
           Cells(ActiveCell.Row, 5) = TxtTelClient.Text
           Cells(ActiveCell.Row, 6) = TxtPU.Text
           Cells(ActiveCell.Row, 7) = Date

        Sheets("liste_transaction").Activate
           TxtNomClient.SetFocus
           [A65536].End(xlUp).Offset(1, 0).Select
           Cells(ActiveCell.Row, 1) = TxtNomClient.Text
           Cells(ActiveCell.Row, 2) = TxtAdresseClient.Text
           Cells(ActiveCell.Row, 3) = TxtTelClient.Text
           Cells(ActiveCell.Row, 4) = CboSalle.Text
           Cells(ActiveCell.Row, 5) = TxtIntituleSalle.Text
           Cells(ActiveCell.Row, 6) = TxtPU.Text
           Cells(ActiveCell.Row, 7) = Date

       Sheets("config").Activate
       For I = 2 To Range("A:A").End(xlDown).Row
             If CboSalle.Text = Cells(I, 1).Text Then
             Cells(I, 1).Select
             Selection.Offset(0, 3) = "1"
             End If
        Next I

          TxtNomClient = ""
          TxtAdresseClient = ""
          TxtTelClient = ""
          CboSalle = ""
          TxtIntituleSalle = ""

End Sub

Private Sub BtnEffacerAjoutForm_Click()
  TxtNomClient = ""
  TxtAdresseClient = ""
  TxtTelClient = ""
  CboSalle = ""
  TxtIntituleSalle = ""
End Sub

Private Sub BtnFermeAjoutNouvClient_Click()
  Unload AjoutNouvClient
End Sub

Private Sub CboSalle_Change()
   Dim I As Integer
   If CboSalle = "" Then
      Label5.Visible = False
      Label6.Visible = False
      TxtPU.Visible = False
      TxtIntituleSalle.Visible = False
      BtnAjoutEntree.Enabled = False
   Else
      Label5.Visible = True
      Label6.Visible = True
      TxtIntituleSalle.Visible = True
      TxtPU.Visible = True
Sheets("CONFIG").Activate
       For I = 2 To Range("A:A").End(xlDown).Row
          If CboSalle.Text = Cells(I, 1) Then
             TxtIntituleSalle = Cells(I, 2).Text
             TxtPU = Cells(I, 3).Text
          End If
       Next I
      BtnAjoutEntree.Enabled = True
   End If
End Sub

Private Sub TxtNomClient_Change()
  If TxtNomClient = "" Then
      BtnEffacerAjoutForm.Enabled = False
      Label4.Visible = False
      Label6.Visible = False
      CboSalle.Visible = False
      TxtPU.Visible = False
  Else
     BtnEffacerAjoutForm.Enabled = True
     Label4.Visible = True

     CboSalle.Visible = True

  End If
End Sub

- le formulaire de saisie des sorties et libération des salles avec les codes suivants:

Private Sub BtnLibere_Click()
        Sheets("CONFIG").Activate
              For I = 2 To Range("A:A").End(xlDown).Row

                       If CboSalle.Text = Cells(I, 1).Text Then

                          Cells(I, 2) = "0"
                      End If
              Next I
        Sheets("LISTE_TRANSACTION").Activate
              For I = 2 To Range("A:A").End(xlDown).Row

                       If CboSalle.Text = Cells(I, 4).Text And TxtNomClient = Cells(I, 1).Text Then

                          Cells(I, 7) = Date
                      End If
              Next I

        Sheets("LISTE_OCCU_SALLE").Activate
              For I = 2 To Range("A:A").End(xlDown).Row

                       If CboSalle.Text = Cells(I, 1).Text Then

                          Cells(I, 1).Select
                      End If
              Next I

End Sub

Private Sub CboSalle_Change()
  Dim I As Integer
     If CboSalle = "" Then
        Label2.Visible = False
        Label3.Visible = False
        Label4.Visible = False
        Label5.Visible = False
        Label6.Visible = False
        Label7.Visible = False
        Label8.Visible = False
        TxtAdresseClient.Visible = False
        TxtDateEntre.Visible = False
        TxtDateSortie.Visible = False
        TxtIntituleSalle.Visible = False
        TxtNomClient.Visible = False
        TxtPU.Visible = False
        TxtTelClient.Visible = False
        BtnLibere.Visible = False
        BtnEffacer.Visible = False
        BtnFermer.Visible = False
    Else
        Label2.Visible = True
        Label3.Visible = True
        Label4.Visible = True
        Label5.Visible = True
        Label6.Visible = True
        Label7.Visible = True
        Label8.Visible = True
        TxtAdresseClient.Visible = True
        TxtDateEntre.Visible = True
        TxtDateSortie.Visible = True
        TxtIntituleSalle.Visible = True
        TxtNomClient.Visible = True
        TxtPU.Visible = True
        TxtTelClient.Visible = True
        BtnLibere.Visible = True
        BtnEffacer.Visible = True
        BtnFermer.Visible = True

            Sheets("LISTE_OCCU_SALLE").Activate
              For I = 2 To Range("A:A").End(xlDown).Row

                       If CboSalle.Text = Cells(I, 1).Text Then

                          TxtIntituleSalle = Cells(I, 2).Text
                          TxtNomClient = Cells(I, 3).Text
                          TxtAdresseClient = Cells(I, 4).Text
                          TxtTelClient = Cells(I, 5).Text
                          TxtPU = Cells(I, 6).Text
                          TxtDateEntre = Cells(I, 7).Text
                          TxtDateSortie = Date

                      End If
              Next I
    End If
End Sub

Private Sub UserForm_Initialize()

  Label2.Visible = False
  Label3.Visible = False
  Label4.Visible = False
  Label5.Visible = False
  Label6.Visible = False
  Label7.Visible = False
  Label8.Visible = False
  CboSalle.Visible = True
  TxtAdresseClient.Visible = False
  TxtDateEntre.Visible = False
  TxtDateSortie.Visible = False
  TxtIntituleSalle.Visible = False
  TxtNomClient.Visible = False
  TxtPU.Visible = False
  TxtTelClient.Visible = False
  BtnLibere.Visible = False
  BtnEffacer.Visible = False
  BtnFermer.Visible = False

End Sub

- le formulaire des point journalier avec le code

Private Sub BtnFermerVal_Click()
 Unload ValideOccuSalle
End Sub

Private Sub BtnValideOccu_Click()
 Dim I As Integer: I = 2
    ThisWorkbook.Worksheets("POINT_JOURNALIER").Activate
    Cells(1, 1).End(xlToRight).Offset(0, 1).Select
    Selection.Value = Date

    ThisWorkbook.Worksheets("config").Activate
    Range("E2:E24").Copy
    ThisWorkbook.Worksheets("POINT_JOURNALIER").Activate
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    BtnValideOccu.Visible = False
    BtnAnnulerOccu.Visible = True

 Sheets("config").Activate
End Sub

Private Sub BtnAnnulerOccu_Click()

 ThisWorkbook.Worksheets("POINT_JOURNALIER").Cells(1, 1).End(xlToRight).EntireColumn.Delete
 BtnAnnulerOccu.Visible = False
 BtnValideOccu.Visible = True
  Sheets("config").Activate
End Sub
Private Sub UserForm_Initialize()
TextBox1 = Date
 If ThisWorkbook.Worksheets("POINT_JOURNALIER").Cells(1, 1).End(xlToRight).Text = TextBox1.Text Then
   BtnValideOccu.Visible = False
   BtnAnnulerOccu.Visible = True
  Sheets("config").Activate
 Else
   BtnValideOccu.Visible = True
   BtnAnnulerOccu.Visible = False
  Sheets("config").Activate
 End If
End Sub

Mais sans le formulaire de saisie des sorties, les autres fonctionnent normalement et quand j'insère son code l'excel se plante.

Merci pour votre attention.

24base-mc-zs.zip (23.79 Ko)
Rechercher des sujets similaires à "creation base donnee gestion salles clients vba"