Renseigner une cellule si une autre est renseignée Résolu

Question

Bonjour , 

J'ai une question, j'ai cherché longtemps sans trouver de réponse.
J'ai sur un fichier Excel plusieurs macros avec plusieurs fonctions (un peu liés). Une des macros génère des feuilles avec des données automatiquement, je voudrai créer une fonction, pour qu'a la génération de ces feuilles :

-Si on trouve dans une colonne dont la valeur de sa premiere cellule like "Liste", si on y trouve une cellule differente de null , je voudrai que dans la ligne correspondante dans la colonne dont la valeur de sa premiere cellule like "Type", qu'une valeur "combobox" soit attribuée.

Liste                   Type  
|                           | 
|                           |
val1 ----------------combobox


Merci à l'avance

pijaku · Answer

Bonjour,

Tout d'abord, dans le code "appelant" de la fonction, il faudra référencer 2 paramètres : les numéros des colonnes "Liste" et "type".
Comme ceci :
Dim ColList As Integer, ColType As Integer
With Sheets("nom_de_ta_feuille")
    ColList = .Rows(1).Find("Liste").Column
    ColType = .Rows(1).Find("Type").Column
End With
Call InscriCombo("nom_de_ta_feuille", ColList, ColType)
Nota : Si tu n'es pas sur à 100% de trouver les deux valeurs "Liste" et "Type" en ligne 1 de ta feuille, il faudra faire différemment.

Et la fonction InscriCombo :
Sub InscriCombo(NomFeuil As String, Liste As Integer, Type As Integer)
Dim Lig As Long, DL As Long
With Sheets(NomFeuil)
    DL = .Columns(Liste).Find("*", , , , xlByColumns, xlPrevious).Row
    If DL = 1 Then Exit Sub
    For Lig = 2 to DL
        If .Cells(Lig, Liste) <> "" Then .Cells(Lig, Type) = "Combobox"
    Next Lig
End With
End Sub

pijaku · Answer

Salut,

1- modifier ta sub d'appel comme ceci :

Public Sub CreationFeuille()
' Crée les feuilles
Dim w As Worksheet          'feuille
Dim r As Range              'plage de cellules
Dim c As Range              'cellule

Dim ColList As Integer
Dim ColType()

Application.ScreenUpdating = False
  'Définir la plage de titres contenant les préfixes du nom des feuilles
  With Worksheets("Donnees").Cells(1, colNom)
    Set r = .Resize(1, .End(xlToRight).Column - .Column + 1)
  End With
  'Ajouter et mettre à jour les feuilles
  For Each c In r.Cells
    '- ajouter la feuille
    Set w = AjoutFeuille(c.Value)
    '- remplir la feuille
    Call RemplirFeuille(w, c)
    'créer le code événementiel
        'Call CreerCode(w.CodeName)
    '- mettre à jour la feuille X
    Call MàjFeuilleX(c.Value)
    Call CollectColType(w, ColType())
    Call InscriCombo(w.Name, ColList, ColType())
  Next c

Application.ScreenUpdating = True
  
  MsgBox "feuilles crées"

End Sub

2- InscriCombo devient :

Private Sub InscriCombo(shName As String, List As Integer, FType())
Dim Lig As Long, DL As Long, Col As Integer
    With Sheets(shName)
        DL = .Columns(List).Find("*", , , , xlByColumns, xlPrevious).Row
        If DL = 1 Then Exit Sub
        For Lig = 2 To DL
            If .Cells(Lig, List) <> "" Then
                For Col = LBound(FType) To UBound(FType)
                    .Cells(Lig, FType(Col)) = "Picklist"
                Next
            End If
        Next Lig
    End With
End Sub

3- Ajouter la fonction :

Private Sub CollectColType(sh As Worksheet, Tb())
Dim Col, i As Integer
With sh
    For Each Col In .UsedRange.Columns
        If .Cells(1, Col.Column) Like "*Type*" Then
            i = i + 1: ReDim Preserve Tb(i): Tb(i) = Col.Column
        End If
    Next
End With
End Sub

Renseigner une cellule si une autre est renseignée

2 réponses

Discussions similaires

Newsletters