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
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top