database manager

Mickael_s

New Member
Joined
Nov 14, 2019
Messages
2
Hello,

I explain my problem, I create a database manager, to use it is very simple, in the sheet BDD Chat you will find a button that opens the manager, once open you will find a combobox that lists the name of the lists, a listbox which lists the items within a list, 1 button add a list, 1 button edit a name list, 1 button remove a list, 1 button add an item, 1 button edit an item, 1 remove an item button and 1 exit button, when we add a list this one created in the sheet BDD in the cell A1, but when I try to create a 2nd list this one overwrites the 1st. Can you help me understand why when I create this 2nd list this one crush the 1st. can not post PJ so I put the code.

Code:
Dim f, LastCol, AddLastRow, LastRow, ColPrivate Sub UserForm_initialize()
    Dim ComboBD
    Set f = Sheets("BDD")
    LastCol = f.Cells(1, Columns.Count).End(xlToLeft).Column
    AddLastCol = Split(f.Cells(1, LastCol).Address, "$")(1) & 1
    ComboBD = WorksheetFunction.Transpose(f.Range("A1:" & AddLastCol))
    Me.ComboBox1.Clear
    If LastCol < 2 Then Exit Sub
    If LastCol = 1 Then Me.ComboBox1.AddItem f.Range("A1"): Exit Sub
    Me.ComboBox1.List = ComboBD
End Sub
Private Sub ComboBox1_Change()
    Dim Plage
    If Me.ComboBox1 = "" Then Me.ListBox1.Clear: Exit Sub
    Me.ListBox1.Clear
    Col = Me.ComboBox1.ListIndex + 2
    AddLastRow = Split(f.Cells(1, Col).Address, "$")(1)
    LastRow = f.Cells(Rows.Count, Col).End(xlUp).Row
    Plage = AddLastRow & 2 & ":" & AddLastRow & LastRow
    If LastRow = 2 Then Me.ListBox1.Clear: Me.ListBox1.AddItem f.Cells(2, Col)
    If LastRow > 2 Then ListeBD = f.Range(Plage).Value: Me.ListBox1.List = ListeBD
    Me.ListBox1.ColumnWidths = f.Columns(Col).Width
End Sub
Private Sub Image2_Click()
    Dim MSG
    MSG = InputBox("Quel est le tire de la nouvelle liste ?", "Ajout d 'une liste")
    If MSG = "" Then Exit Sub
    f.Cells(1, LastCol + 1) = MSG
    UserForm_initialize
    Me.ComboBox1 = MSG
End Sub
Private Sub Image3_Click()
    Dim MSG
    If Me.ComboBox1 = "" Then Exit Sub
    MSG = InputBox("Quel est le nouveau titre de la liste ?", "Modification", Me.ComboBox1)
    If MSG = "" Then Exit Sub
    f.Cells(1, Col) = MSG
    UserForm_initialize
    Me.ComboBox1 = MSG
End Sub
Private Sub Image4_Click()
    Dim MSG
    If Me.ComboBox1 = "" Then Exit Sub
    MSG = MsgBox("Confirmer la suppression de la liste " & Me.ComboBox1 & " ainsi que tout son contenue ?", vbYesNo + vbCritical, "Suppression")
    If MSG = vbYes Then
        f.Columns(AddLastRow & ":" & AddLastRow).Delete shift:=xlToLeft
        UserForm_initialize
    End If
    If MSG = vbNo Then
        Exit Sub
    End If
End Sub
Private Sub Image5_Click()
    Dim MSG
    If Me.ComboBox1 = "" Then Exit Sub
    MSG = InputBox("Quel est le nouvel item à ajouter ?", "Ajout dans liste " & Me.ComboBox1)
    If MSG = "" Then Exit Sub
    If IsDate(MSG) Then f.Cells(LastRow + 1, Col) = CDate(MSG)
    If Not IsDate(MSG) Then f.Cells(LastRow + 1, Col) = MSG
    If LastRow > 1 Then f.Range(AddLastRow & 2 & ":" & AddLastRow & LastRow + 1).Sort key1:=f.Cells(3, Col), order1:=xlAscending
    f.Columns(AddLastRow & ":" & AddLastRow).AutoFit
    ComboBox1_Change
End Sub
Private Sub Image7_Click()
    Dim MSG
    If Me.ComboBox1 = "" Then Exit Sub
    If IsNull(Me.ListBox1) = True Then Exit Sub
    MSG = InputBox("Modification de l             'item suivant :", "Modification", Me.ListBox1)
    If MSG = "" Then Exit Sub
    If IsDate(MSG) Then f.Cells(Me.ListBox1.ListIndex + 2, Col) = CDate(MSG)
    If Not IsDate(MSG) Then f.Cells(Me.ListBox1.ListIndex + 2, Col) = MSG
    If LastRow > 1 Then f.Range(AddLastRow & 2 & ":" & AddLastRow & LastRow + 1).Sort key1:=f.Cells(3, Col), order1:=xlAscending
    f.Columns(AddLastRow & ":" & AddLastRow).AutoFit
    ComboBox1_Change
End Sub
Private Sub Image6_Click()
    Dim MSG
    If Me.ComboBox1 = "" Then Exit Sub
    If IsNull(Me.ListBox1) = True Then Exit Sub
    MSG = MsgBox("Confirmer la supression de " & Me.ListBox1 & " ?", vbYesNo + vbCritical, "Supression")
    If MSG = vbYes Then f.Cells(Me.ListBox1.ListIndex + 2, Col).Delete shift:=xlUp
    If MSG = vbNo Then Exit Sub
    f.Columns(AddLastRow & ":" & AddLastRow).AutoFit
    ComboBox1_Change
End Sub
Private Sub Image1_Click()
    Unload Me
End Sub

Thank you
 

Forum statistics

Threads
1,078,365
Messages
5,339,768
Members
399,323
Latest member
letitiaysk

Some videos you may like

This Week's Hot Topics

Top