Mise à jour automatique de Listes déroulantes
Bonjour,
Je cherche à automatiser une série de liste déroulante. J'ai sur ma "Feuil1" tous mes champs à sélectionner à partir de la ligne 3 jusqu’à la ligne "exist" calculé selon le nombre de cellules pleine dans la colonne. le compteur des colonnes est appelé "col"
la première ligne sert de référence pour la feuil où se trouvera la liste déroulante et la deuxième ligne contient la lettre de la colonne dans la quelle se trouvera la liste déroulante sans l'autre feuil
dans plusieurs feuilles différentes je cherche à mettre à jour dans des blocs de taille défini (sur une mémé colonne de a ligne bloq à bloq + 23)
Le problème est au niveau de ce que je doit renseigner pour la fonction Formula1:=
Voici le bout de code en question :
With Sheets("Feuil1")
liste = Cells(2, col) & "3:" & Cells(2, col) & exist
End With
ws.Select
Range(Cells(bloq, col ), Cells(bloq + 23, col)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=liste"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
test = liste
End With
Merci d’avance
Bonsoir,
de mon coté (de notre coté
Ha ben forcément, il n'y en a pas !
Ou disons plutôt que personnellement je comprend mieux les problèmes avec un support...
@ bientôt
LouReed
Oui désolé j'avais essayer d'isoler la partie "utile" car le code est assez long et a plusieurs utilitées
dont mettre a jours le contenu de la liste déroulante.
et désolé pour tous les commentaires j'ai fais plusieurs tests non frutueux
voici le code complet.
- Public Sub liste_deroulante()
Dim lon1(20) As Integer
Dim lon2(20) As Integer
Dim debut As Integer, exist As Integer
Dim ws As Worksheet
Dim tipe As String
Dim lim As Integer
Dim test As String
Dim bloq As Integer
Dim liste As String
Dim col As Integer
'boucle sur tous les types de feuilles
'~~~~~~~~~~~
For i = 1 To 6
debut = 1 + (i - 1) * 40
tipe = Sheets("Feuil1").Cells(1, debut + 1).Value
If i = 1 Then
bloq = 39
Else
bloq = 47
End If
'boucle surte toutes les colonnes du type en selection
For col = debut + 1 To debut + 40
'compte le nombre de com deja existant pour pouvoir ajouter les nouveaux à la suite
exist = Application.WorksheetFunction.CountA(Columns(col))
'boucle sur toutes les feuilles de la colonne en selection
For Each ws In Worksheets
If ws.Name Like tipe Then
If (col - debut < 21) Then
For lin = bloq To bloq + 23
If ws.Cells(lin, col - debut) = "" Then
Exit For
Else
Worksheets("Feuil1").Cells(exist + 1, col) = ws.Cells(lin, col - debut)
test = Worksheets("Feuil1").Cells(exist + 1, col)
exist = exist + 1
End If
Next lin
With Sheets("Feuil1")
' .Activate
' '.Range(Cells(2, col) & "3:" & Cells(2, col) & exist).Select
' 'ActiveWorkbook.Names.Add Name:="liste", RefersTo:="=" & "Feuil1!" & Selection.Address
liste = "=Feuil1!" & Cells(2, col) & "3:" & Cells(2, col) & exist
' test = Cells(2, col)
End With
'liste = Sheets("Feuil1").Range("Feuil1!" & Cells(2, col).Value & "3:" & Cells(2, col).Value & exist)
'Sheets("Feuil1").Range("B3:B6").Names.Add Name:="liste", RefersTo:="=" & "Feuil1!" & Selection.Address
'liste = "Cells(3, col) , Cells(exist, col)"
ws.Select
Range(Cells(bloq, col - debut), Cells(bloq + 23, col - debut)).Select
With Selection.Validation
.Delete
'Formula1:="=Feuil1!$B$2:$B$3"
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=DECALER(Feuil1!$A$1;2;col-1;exist-2;1)"
'Worksheets("Feuil1").Range(Cells(3, col), Cells(exist, col))
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
'test = liste
End With
Else
For lin = bloq + 26 To bloq + 63
If ws.Cells(lin, col - debut - 20) = "" Then
Exit For
Else
Worksheets("Feuil1").Cells(exist + 1, col) = ws.Cells(lin, col - debut - 20)
test = Worksheets("Feuil1").Cells(exist + 1, col)
exist = exist + 1
End If
Next lin
With Sheets("Feuil1")
liste = Cells(2, col) & "3:" & Cells(2, col) & exist
End With
Range(Cells(bloq, col - debut - 20), Cells(bloq + 23, col - debut - 20)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=liste"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
'recuperer tous les commentaires
End If
'suprimer les doublons
Next ws
'faire ceci pour toutes les types de pages
'a la fin de toutes les boucles ..................
'mettre a jour la selection des listes deroulantes dans le fichier virege
'fin boucle sur feuilles
Worksheets("Feuil1").Activate
ActiveSheet.Columns(col).RemoveDuplicates Columns:=1, Header:=xlNo
'Call supr_dbl(col, ThisWorkbook.ActiveSheet)
'fin boucle sur colonnes
Next col
Next i
End Sub
Je dirais presque que c'est pire !
Trop de code et surtout sans utilisation des balises d'édition !
Le fichier, c'est pas possible ?
@ bientôt
LouReeD
Le fichier entier serait pire. Je vais essayer de cybler la partie pertinente.
Par contre peu tu me dire comment ajouter les balises ?
Merci
Voici la partie du code réduit au maximum.
Public Sub liste_deroulante()
Dim lon1(20) As Integer
Dim lon2(20) As Integer
Dim debut As Integer, exist As Integer
Dim ws As Worksheet
Dim tipe As String
Dim lim As Integer
Dim test As String
Dim bloq As Integer
Dim liste As String
Dim col As Integer
'boucle sur tous les types de feuilles
'~~~~~~~~~~~
For i = 1 To 6
'il y a 40 colonnes pour chaque type de feuilles
debut = 1 + (i - 1) * 40
'la première ligne de la "feuil1" contient le début du nom des feuilles dans lesquel le traitement doit etre fait
tipe = Sheets("Feuil1").Cells(1, debut + 1).Value
'délimite lla première ligne du champs où se trouvera les liste deroulantes
bloq = 39
'boucle sur toutes les colonnes du type en selection
For col = debut + 1 To debut + 40
'compte le nombre de com deja existant sur la colone
exist = Application.WorksheetFunction.CountA(Columns(col))
'boucle sur toutes les feuilles et execute seulement pour le type de feuille voulu
For Each ws In Worksheets
If ws.Name Like tipe Then
With Sheets("Feuil1")
liste = "=Feuil1!" & Cells(2, col) & "3:" & Cells(2, col) & exist
End With
ws.Select
Range(Cells(bloq, col - debut), Cells(bloq + 23, col - debut)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=liste"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
'test = liste
End With
End If
Next ws
Next col
Next i
End Sub