Projet classeur automatisé résultat concours chat

**mickaeldu45** · 11/11/2019, 16h31

Bonjour,

J'ouvre cette discussion pour avoir de l'aide concernant mon projet.

Je vais poster les questions au fur et à mesure de l'avancement du projet, cela permettra de résoudre les problème pas à pas.

Ma 1ere question concerne le gestionnaire de liste qui se trouve dans le classeur, pour ouvrir le gestionnaire il faut cliquer sur le bouton se trouvant sur la feuille BDD Chat.

1er problème lorsque je créer une nouvelle liste celle ci se crée dans la colonne B de la feuille BDD hors je voudrais que le remplissage commence en colonne A

2eme problème lors de la création d'une nouvelle liste avec un nom trop long la colonne n'est pas redimensionné.

Pour le reste tout fonctionne correctement donc inutile de faire une refonte complet du code sauf pour l'alléger.

Pouvez vous m'aider à régler ses 2 premier problème afin que je puisse avancer dans mon projet. Pour m'aider je préfère que vous m’expliquiez les parties de code à modifier afin de m'aider à comprendre.

Je met en PJ le classeur.Tableur Expo v2.xlsm

Merci

**anasecu** · 11/11/2019, 19h01

Bonjour,

Envoyé par mickaeldu45

1er problème lorsque je créer une nouvelle liste celle ci se crée dans la colonne B

Lorsque tu cherches ta dernière colonne, si ta ligne est vide tu obtiens 1 et 1 + 1 cela fait B ;-)
Donc à toi de régler ce souci.

Envoyé par mickaeldu45

2eme problème lors de la création d'une nouvelle liste avec un nom trop long la colonne n'est pas redimensionné.

Il faut rajouter un 'autofit' sur la colonne de ta cellule concernée.

**mickaeldu45** · 11/11/2019, 19h27

Voici le code d'origine :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Dim f, ColMax, LetCol, Max, Colonne
Private Sub UserForm_initialize()
Dim ComboBD
Set f = Sheets("BDD")
ColMax = f.Cells(1, f.Cells.Columns.Count).End(xlToLeft).Column
LetColMax = Split(f.Cells(1, ColMax).Address, "$")(1) & 1
ComboBD = WorksheetFunction.Transpose(f.Range("B1:" & LetColMax))
Me.ComboBox1.Clear
If ColMax < 2 Then Exit Sub
If ColMax = 2 Then Me.ComboBox1.AddItem f.Range("B1"): 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
Colonne = Me.ComboBox1.ListIndex + 2
LetCol = Split(f.Cells(1, Colonne).Address, "$")(1)
Max = f.Cells(65000, Colonne).End(xlUp).Row
Plage = LetCol & 2 & ":" & LetCol & Max
If Max = 2 Then Me.ListBox1.Clear: Me.ListBox1.AddItem f.Cells(2, Colonne)
If Max > 2 Then ListeBD = f.Range(Plage).Value: Me.ListBox1.List = ListeBD
Me.ListBox1.ColumnWidths = f.Columns(Colonne).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, ColMax + 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, Colonne) = 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(LetCol & ":" & LetCol).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(Max + 1, Colonne) = CDate(MSG)
If Not IsDate(MSG) Then f.Cells(Max + 1, Colonne) = MSG
If Max > 1 Then f.Range(LetCol & 2 & ":" & LetCol & Max + 1).Sort key1:=f.Cells(3, Colonne), order1:=xlAscending
f.Columns(LetCol & ":" & LetCol).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, Colonne) = CDate(MSG)
If Not IsDate(MSG) Then f.Cells(Me.ListBox1.ListIndex + 2, Colonne) = MSG
If Max > 1 Then f.Range(LetCol & 2 & ":" & LetCol & Max + 1).Sort key1:=f.Cells(3, Colonne), order1:=xlAscending
f.Columns(LetCol & ":" & LetCol).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, Colonne).Delete shift:=xlUp
If MSG = vbNo Then Exit Sub
f.Columns(LetCol & ":" & LetCol).AutoFit
ComboBox1_Change
End Sub
Private Sub Image1_Click()
Unload Me
End Sub

Par rapport à ce que tu me dit "si ta ligne est vide tu obtiens 1 et 1 + 1 cela fait B" ==> je modifierais la ligne 29 cela donnerais :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

f.Cells(1, ColMax + 0) = MSG

Pour l'autofit je ne vois pas ou l'utiliser

Envoyé par anasecu

Bonjour,

Lorsque tu cherches ta dernière colonne, si ta ligne est vide tu obtiens 1 et 1 + 1 cela fait B ;-)
Donc à toi de régler ce souci.

Il faut rajouter un 'autofit' sur la colonne de ta cellule concernée.

**mickaeldu45** · 11/11/2019, 22h03

Bonsoir à tous,

Pour m'aider à comprendre le langage VBA quelqu'un serait il prêt à me décrire la fonction de chaque ligne de ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Dim f, ColMax, LetCol, Max, Colonne
Private Sub UserForm_initialize()
Dim ComboBD
Set f = Sheets("BDD")
ColMax = f.Cells(1, f.Cells.Columns.Count).End(xlToLeft).Column
LetColMax = Split(f.Cells(1, ColMax).Address, "$")(1) & 1
ComboBD = WorksheetFunction.Transpose(f.Range("B1:" & LetColMax))
Me.ComboBox1.Clear
If ColMax < 2 Then Exit Sub
If ColMax = 2 Then Me.ComboBox1.AddItem f.Range("B1"): 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
Colonne = Me.ComboBox1.ListIndex + 2
LetCol = Split(f.Cells(1, Colonne).Address, "$")(1)
Max = f.Cells(65000, Colonne).End(xlUp).Row
Plage = LetCol & 2 & ":" & LetCol & Max
If Max = 2 Then Me.ListBox1.Clear: Me.ListBox1.AddItem f.Cells(2, Colonne)
If Max > 2 Then ListeBD = f.Range(Plage).Value: Me.ListBox1.List = ListeBD
Me.ListBox1.ColumnWidths = f.Columns(Colonne).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, ColMax + 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, Colonne) = 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(LetCol & ":" & LetCol).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(Max + 1, Colonne) = CDate(MSG)
If Not IsDate(MSG) Then f.Cells(Max + 1, Colonne) = MSG
If Max > 1 Then f.Range(LetCol & 2 & ":" & LetCol & Max + 1).Sort key1:=f.Cells(3, Colonne), order1:=xlAscending
f.Columns(LetCol & ":" & LetCol).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, Colonne) = CDate(MSG)
If Not IsDate(MSG) Then f.Cells(Me.ListBox1.ListIndex + 2, Colonne) = MSG
If Max > 1 Then f.Range(LetCol & 2 & ":" & LetCol & Max + 1).Sort key1:=f.Cells(3, Colonne), order1:=xlAscending
f.Columns(LetCol & ":" & LetCol).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, Colonne).Delete shift:=xlUp
If MSG = vbNo Then Exit Sub
f.Columns(LetCol & ":" & LetCol).AutoFit
ComboBox1_Change
End Sub
Private Sub Image1_Click()
Unload Me
End Sub

**anasecu** · 11/11/2019, 22h05

re

Envoyé par mickaeldu45

=> je modifierais la ligne 29 cela donnerais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

f.Cells(1, ColMax + 0) = MSG

Je ne pense pas car ainsi seul le premier fonctionne mais comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

f.Cells(1, ColMax + IIf(ColMax = 1, 0, 1)) = MSG

lien pour l'aide iif

Envoyé par mickaeldu45

Pour l'autofit je ne vois pas ou l'utiliser

Après la ligne où tu valorises ta cellule tout simplement.

Envoyé par mickaeldu45

Pour m'aider à comprendre le langage VBA quelqu'un serait il prêt à me décrire la fonction de chaque ligne de ce code :

Microsoft l'a fait, il suffit de sélectionner la fonction dans l'éditeur et tu as sa description, sa syntaxe et un exemple d'utilisation, comme sur le lien que je t'ai mis au-dessus.

**mickaeldu45** · 12/11/2019, 08h28

Envoyé par anasecu

Après la ligne où tu valorises ta cellule tout simplement.

Pour l'AutoFit j'ai rajouté ce qui est écrit en rouge :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Dim f, ColMax, LetCol, Max, Colonne
Private Sub UserForm_initialize()
Dim ComboBD
Set f = Sheets("BDD")
ColMax = f.Cells(1, f.Cells.Columns.Count).End(xlToLeft).Column
LetColMax = Split(f.Cells(1, ColMax).Address, "$")(1) & 1
ComboBD = WorksheetFunction.Transpose(f.Range("B1:" & LetColMax))
Me.ComboBox1.Clear
If ColMax < 2 Then Exit Sub
If ColMax = 2 Then Me.ComboBox1.AddItem f.Range("B1"): 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
Colonne = Me.ComboBox1.ListIndex + 2
LetCol = Split(f.Cells(1, Colonne).Address, "$")(1)
Max = f.Cells(65000, Colonne).End(xlUp).Row
Plage = LetCol & 2 & ":" & LetCol & Max
If Max = 2 Then Me.ListBox1.Clear: Me.ListBox1.AddItem f.Cells(2, Colonne)
If Max > 2 Then ListeBD = f.Range(Plage).Value: Me.ListBox1.List = ListeBD
Me.ListBox1.ColumnWidths = f.Columns(Colonne).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, ColMax + 1) = MSG
f.Columns.AutoFit
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, Colonne) = MSG
f.Columns.AutoFit
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(LetCol & ":" & LetCol).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(Max + 1, Colonne) = CDate(MSG)
If Not IsDate(MSG) Then f.Cells(Max + 1, Colonne) = MSG
If Max > 1 Then f.Range(LetCol & 2 & ":" & LetCol & Max + 1).Sort key1:=f.Cells(3, Colonne), order1:=xlAscending
f.Columns(LetCol & ":" & LetCol).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, Colonne) = CDate(MSG)
If Not IsDate(MSG) Then f.Cells(Me.ListBox1.ListIndex + 2, Colonne) = MSG
If Max > 1 Then f.Range(LetCol & 2 & ":" & LetCol & Max + 1).Sort key1:=f.Cells(3, Colonne), order1:=xlAscending
f.Columns(LetCol & ":" & LetCol).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, Colonne).Delete shift:=xlUp
If MSG = vbNo Then Exit Sub
f.Columns(LetCol & ":" & LetCol).AutoFit
ComboBox1_Change
End Sub
Private Sub Image1_Click()
Unload Me
End Sub

Après essai mes colonnes sont redimensionné lors de la création ou la modification d'une liste donc le problème de largeur automatique est réglé.

Pour ce qui est du 1er problème (remplissage à partir de la colonne A et non à partir de B j'y arrive mais après mon combobox est vide puisque tout est décalé.

**anasecu** · 12/11/2019, 18h19

Bonsoir,

Envoyé par mickaeldu45

Pour ce qui est du 1er problème (remplissage à partir de la colonne A et non à partir de B j'y arrive mais après mon combobox est vide puisque tout est décalé.

Tu peux remplacer ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
LetColMax = Split(f.Cells(1, ColMax).Address, "$")(1) & 1
ComboBD = WorksheetFunction.Transpose(f.Range("B1:" & LetColMax))
Me.ComboBox1.Clear
If ColMax < 2 Then Exit Sub
If ColMax = 2 Then Me.ComboBox1.AddItem f.Range("B1"): Exit Sub
Me.ComboBox1.List = ComboBD

par cette ligne pour initialiser ton combobox :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.ComboBox1.List = Application.Transpose(f.Cells(1, 1).Resize(1, ColMax).Value)

Projet classeur automatisé résultat concours chat

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager