Utilisation du nom des colonnes et non des lettres

Bonjour à tous ,

J'ai réalisé une macro VBA très complète, j'y travaille dessus depuis plusieurs mois dans le cadre de mon alternance.

Je me rapproche de la fin et une demande particulière m'a été faite pour rajoute une colonne en plein milieu de mon tableur Excel (en lien avec la macro), vous imaginez bien que tout mon code va se décaler puisque je travaillais avec les numéros de colonnes ou leur lettre .

J'aimerais donc pour éviter de devoir changer l'ensemble de mon code à chaque modification et travailler avec les nom de la colonne située sur la ligne 1.

-> Première interrogation est-ce possible ?

-> Deuxième question quelle est la méthode la plus simple pour répondre à ma demande sur une partie du code suivant ?

-> Et enfin troisième et dernière question comment bloquer les cellules de la ligne 1 pour qu'elles ne soient pas modifiées inopinément par les futurs utilisateurs (ce qui rendrait le code inutilisable ) ?

Public Sub CommandButton3_Click()

Dim Derniere As Integer
Derniere = DerniereLigne()

Dim colonneA As Range 'valeur de la cellule A1 = toto
Set colonneA = Acolon()

Dim valref as integer
valref = 3
Dim fso, SourceFolder, SubFolder, fichier, cheminETnom
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(Repertoire)

    For Each fichier In SourceFolder.Files
        If InStr(1, Repertoire & "\" & fichier.Name, ref, vbTextCompare) > 0 Then
            cheminETnom = LCase$(Repertoire & "\" & fichier.Name)
            Select Case valref
                Case 3: cells(k, 6).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\"))) 'ici modif F1 = titi
                Case 4: cells(k, 7).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\"))) 'ici modif G1 = tutu
            End Select
    Next fichier

End sub

Function Acolon()
        Set Acolon = Feuil2.Range(Feuil2.cells(2, 1), Feuil2.cells(Derniere, 1)) 'ici modif A1 = toto
End Function

Function DerniereLigne()
Feuil2.Activate
DerniereLigne = 2 'première colonne à vérifier

    Do While Not IsEmpty(cells(DerniereLigne, 1)) 'ici modif A1 = toto
        DerniereLigne = DerniereLigne + 1
    Loop

DerniereLigne = DerniereLigne - 1
End Function

Merci pour votre aide

Bonne journée ensoleillée

Bonjour, il est tout a fiat possible d'utiliser des noms à la place de lettre pour le colonne.

exemple si vous donnez le nom "Maselection1" à la colonne A alors une selection de la colonne A devient :

Sub Macro1()
Columns("A:A").Select 'Exemple de sélection colonne A
End Sub
Sub Macro2()
Range("Maselection1").Select  ' Exemple de sélection si la colonne A porte le nom "Maselection1"
End Sub

Concernant la protection de la ligne 1 ( par défaut ) quand on interroge format cellule / protection on peut voir que les cellules sont verrouillées.

Vous devez donc faire une Sélection des cellules qui seront autorisées ( dans votre exemple toutes sauf ligne 1) et décocher le verrouillage.

Ensuite une simple protection de la Feuille et la ligne 1 ne sera plus active en modification.

Je ne crois que ça puisse fonctionner dans le contexte où je suis ce n'est pas un tableau juste le tableur. Comment puis je faire pour sélectionner Masélection1 de la ligne 2 à la dernière calculée ? Est ce que vous pouvez me réécrire la fonction Acolon avec votre proposition car je ne vois pas trop comment m'y prendre ?

Bonjour à tous les 2,

Le mieux serait quand même de mettre sous forme de tableau structuré. Sinon, pourquoi aller de la ligne 2 à la fin ?

Par exemple, votre fonction Acolon ne servirait plus à rien avec un tableau structuré et vous pourriez réécrire le code ainsi :

Sub XXX()

'.....

    For Each fichier In SourceFolder.Files
        If InStr(1, Repertoire & "\" & fichier.Name, ref, vbTextCompare) > 0 Then
            cheminETnom = LCase$(Repertoire & "\" & fichier.Name)
            Select Case valref
                Case 3: Range(NOMTAB[NOMCOL6])(k).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\"))) 'que vaut k ???
                Case 4: Range(NOMTAB[NOMCOL7])(k).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\")))
            End Select
    Next fichier

'.....

end sub

en remplaçant NOMTAB et NOMCOL par les vrais noms du tableau et des colonnes en question.

Pour éviter que les noms d'en-têtes ne soient changés, vous pouvez protéger la feuille. Sinon, s'il n'y a pas d'autres insertions de colonnes prévues, vous pouvez éventuellement ajouter ce code dans le module de la feuille concernée :

private sub worksheet_change(byval target as range)

dim titres
titres = Array("Titrecol1", ..., "Titrecoln") 'fixés en dur dans le code

if not intersect(target, Range(NOMTABLEAU[#Headers])) is nothing then 'si un titre est modifié
    application.enableevents = False 'désactive évènements
    Range(NOMTABLEAU[#Headers]).value = titres 'remet les bons titres (donc empêche chgt)
    application.enableevents = True 'réactive évènements
end if

end sub

Mais si des insertions de colonnes sont à prévoir, c'est que le projet n'est probablement pas encore totalement terminé...

Cdlt,

Alors personnellement je n'utilise jamais de tableau et je ne sais pas vraiment coder dessus est ce que si je crée un tableau ça sera toujours possible de lui rajouter des lignes avec des extractions access ?

Disons que c'est à peu près pareil mais en mieux, en plus facile...

Alors, je ne connais rien à access mais j'imagine que oui. L'avantage du tableau, c'est qu'il se restructure automatiquement. Si on colle des valeurs sur la ligne après le tableau, ces valeurs sont absorbées par le tableau.

Ah oui très bien alors et je peux toujours compter mes lignes utilisées pour coller après le tableau ?

Oui, bien sûr, c'est toujours possible.

Sub aaa()

dl = range("montableau").rows.count 'compte les lignes de données du tableau
nbl = listobjects("montableau").rows.count 'compte toutes les lignes (en-tetes comprises) du tableau
'normalement
range("montableau[macol]")(dl+1) représente la première cellule après le tableau en colonne macol
range("montableau[macol]")(nbl) représente aussi la première ligne après le tableau en colonne macol
listobjects("montableau").listrows.add 'permet d'ajouter une ligne

end sub

La seule contrainte est de raisonner en pensant aux lignes que le tableau contient et non plus en lignes vides. L'idée est donc de n'avoir aucune ligne vide, et notamment en fin de tableau...

Ah oui d'accord merci ça va m'être utile pour tout mettre mon code à jour (ça risque d'être long )..

Effectivement ça risque de poser un gros problème pour la suite si les lignes du tableaux vides sont également comptées peut être que je peux garder ma fonction dernierligne pour être sur de n'avoir aucun problème pour une utilisation particulière.

Je ne sais pas à quoi ressemble le fichier donc je ne peux pas m'avancer.

Mais il est toujours préférable d'éviter d'avoir des lignes vides dans un tableau, surtout s'il est alimenté par des macros...

Mais en effet, ça peut être laborieux . Courage en tout cas

C'est vraiment très compliqué de le partager il y a beaucoup trop d'info confidentiels à enlever. Par contre sur la fonction ListObject ça me demande de la déclarer et pour le nbl ? as integer ?

Normalement as integer, pour la sécurité : as long.

ListObjects("nomdutableau") est justement l'objet tableau structuré ListObject de la collection ListObjects alors que range("nomdutableau") est la plage correspondant aux données du tableau (équivalent de listobjects("nomdutableau").databodyrange), donc sans la ligne d'en-têtes. Il n'est pas nécessaire de déclarer le tableau en tant que listobject. Tout dépend des besoins mais je trouve pour ma part plus simple de rester sur range("nomdutableau") éventuellement déclaré comme range...

Mais avant tout, il faut créer les tableaux et les nommer dans le code comme ils sont nommés sur excel.

Option Explicit

Private sub CommandButton1_Click()

Dim nbl As Integer
Dim ListObjects
Dim lign as integer
Dim k as integer

nbl = ListObjects("Tableau1").Rows.Count

For Each cell In Range("Tableau1[TOTO]")(nbl)
cell = 500
Next

Sheets("TITI").Select

Call emplacement

For Each cell In Range("Tableau1[TATA]")(nbl)
        If cell.Interior.Color = RGB(255, 0, 0) Or cell.Interior.Color = RGB(0, 255, 0) Then
            cpt = cpt + 1
        End If
Next

End sub 

Public Sub emplacement() 

lign = 2
k = 2

    For Each cell In Range("Tableau1[TUTU]")(nbl)

        Call lire
        column = 5
        Call regroupement
        lign = lign + 1
        k = k + 1
    Next
End Sub

Public Sub lire() 'procédure permettant d'identifier l'adresse du dossier où chercher les images ou de quitter la procédure si la cellule étudiée est vide

Dim Repertoire As FileDialog
ref = cells(lign, 1) 'comment je fais pour que ref prenne successivement les valeurs de la première colonne du tab

    If ref = "" Then
        compteur = 2
        Exit Sub
    End If

ListeFichiers Range("J1")

End Sub

J'ai commencé à remplacer par le code que vous m'aviez fourni mais pas concluant si je ne déclare pas ListObject j'ai une erreur comme quoi je ne l'ai pas déclarée quand je le déclare j'ai une incompatibilité de type.

Alors, pour l'instant, c'est pas tout à fait limpide. Mais, ici, j'ai l'impression qu'on travaille sur les valeurs existantes du tableau. Donc on ne s'intéresse pas à la dernière ligne, qui nous importerait si on voulait savoir où copier de nouvelles lignes.

Option Explicit

Private sub CommandButton1_Click()

For Each cell In Range("Tableau1[TOTO]")
    cell.value = 500 'chaque cellule de la colonne TOTO du Tableau1 prend la valeur 500
Next

'ancienne macro emplacement
For Each cell In Range("Tableau1[TUTU]")
    'ancienne macro Lire
    If cell.value = "" Then
        compteur = 2 '???
        Exit for 'ou exit sub ?
    End If
    'ListeFichiers Range("J1") '???
    Call regroupement '???
Next

For Each cell In Range("Tableau1[TATA]")
    If cell.Interior.Color = RGB(255, 0, 0) Or cell.Interior.Color = RGB(0, 255, 0) Then
        cpt = cpt + 1 ' ???
    End If
Next

End sub 

Est-ce que ça donne quelque chose ?

Option Explicit

Private sub CommandButton1_Click()

For Each cell In Range("Tableau1[TOTO]")
    cell.value = 500 'chaque cellule de la colonne TOTO du Tableau1 prend la valeur 500
Next

'ancienne macro emplacement
For Each cell In Range("Tableau1[TUTU]")
    'ancienne macro Lire
    If cell.value = "" Then
        compteur = 2 
        Exit for 'ou exit sub ?
    End If
    ListeFichiers Range("J1") '???
    Call regroupement 
Next

For Each cell In Range("Tableau1[TATA]")
    If cell.Interior.Color = RGB(255, 0, 0) Or cell.Interior.Color = RGB(0, 255, 0) Then
        cpt = cpt + 1 ' ???
    End If
Next

End sub 

Sub regroupement ()

Dim nom as string 
nom = cells (lign, 2) 
Select case compteur
Case 0 : cells (lign,column).interior.color = RGB (255,0,0)
Case 1,2 : compteur = 0
End select

End sub

Effectivement c'est mieux et cela raccourci mon code ! Je n'avais pas fait attention qu'il y avait regroupement la voici, ça vous éclaire sur l'utilité du compteur, en ce qui concerne ListeFichiers range ("J1") je ne veux pas y toucher c'est lié à un code que je trouve compliqué qui permet de chercher des images dans un dossier et des sous dossiers, la cellule J1 contient le lien vers le fichier source si vous avez comment je pourrais le mettre directement dans le code sans avoir à rentrer l'adresse dans la cellule à chaque fois ça m'intéresse !

Sub ListeFichiers(Repertoire As String) 'procédure permettant de trouver le nom de l'image dans le répertoire ou sous répertoires, la cellule est colorée si l'image trouvée n'a pas la bonne extension

Dim fso, SourceFolder, SubFolder, fichier, cheminETnom
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(Repertoire)

    For Each fichier In SourceFolder.Files
        If InStr(1, Repertoire & "\" & fichier.Name, ref, vbTextCompare) > 0 Then
            cheminETnom = LCase$(Repertoire & "\" & fichier.Name)
            cells(k, 5).Value = Split(cheminETnom, "\")(UBound(Split(cheminETnom, "\")))
            compteur = compteur + 1
            If compteur > 0 Then Exit Sub
        End If

        If fichier Like "*_" & ref & ".tif" Or fichier Like "*_" & ref & ".bmp" Or fichier Like ref & ".tif" Or fichier Like ref & ".bmp" Then
             cells(lign, 5).Interior.Color = RGB(0, 255, 0)
            compteur = compteur + 1
            If compteur > 0 Then Exit Sub
            End If
    Next fichier

    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder

End Sub

J'ai rajouté la code de regroupement au sein de la boucle sur la colonne TUTU.

Pour l'instant, je ne touche pas aux conditions du code mais il faudra y réfléchir. Est-ce que les cellules à colorer sont bien dans colonne TUTU ? compteur a-t-il une autre valeur que 0 ou 2 ? Quand vaudrait-il 1 ?

J'ai l'impression qu'on pourrait condenser un peu le code en enlevant des conditions redondantes.

Option Explicit

Private sub CommandButton1_Click()

For Each cell In Range("Tableau1[TOTO]")
    cell.value = 500 'chaque cellule de la colonne TOTO du Tableau1 prend la valeur 500
Next

'ancienne macro emplacement
For Each cell In Range("Tableau1[TUTU]")
    'ancienne macro Lire
    If cell.value = "" Then
        compteur = 2 
        Exit for 'ou exit sub ?
    End If
    ListeFichiers Range("J1") '???
    'ancienne macro regroupement
    Select case compteur
        Case 0 : cell.interior.color = RGB (255,0,0)
        Case 1, 2 : compteur = 0
    End select
Next

For Each cell In Range("Tableau1[TATA]")
    If cell.Interior.Color = RGB(255, 0, 0) Or cell.Interior.Color = RGB(0, 255, 0) Then
        cpt = cpt + 1 ' ???
    End If
Next

End sub 

Edit : d'accord, compteur a bien d'autres valeurs possibles

Effectivement compteur ne peut prendre que 0 ou 2 j'avais autre chose avant avec 1 mais ce n'est plus d'actualité.

Oui ce sont bien les cellules de tutu qui sont colorées par la suite si une cellule de TUTU est colorée alors celle de la colonne d'a côté et sur la même ligne l'est aussi.

Le cpt sert à dénombrer le nombre de cellules colorées et est utilisé dans un MsgBox après (message contenant des infos personnelles donc absent).

C'est bien un exit sub il faut que toutes les lignes aient une valeur dans cette colonne sinon on arrête la procédure.

Private Sub CommandButton2_Click() 'clic sur associer les valeurs manquantes

For Each cell In Range("Tableau1[TOTO]")
cell.Value = 500
Next

Sheets("FINITIONS").Select

    'boucle qui permet voir dans la colonne toutes les références
    For Each cell In Range("Tableau1[TUTU]")
        If cell.Value = "" Then
            compteur = 2
            Exit Sub
        End If

ListeFichiers Range("J1")

Select Case compteur
        Case 0: cell.Interior.Color = RGB(255, 0, 0)
        Case 2: compteur = 0
    End Select

    Next

    ' cette boucle permet de voir pour chaque cellules de la colonne si on a des cases colorées ou non, en fonction de celà un certain message est envoyé à l'utilisat.rice.eur

    For Each cell In Range("Tableau1[TATA]")
        If cell.Interior.Color = RGB(255, 0, 0) Or cell.Interior.Color = RGB(0, 255, 0) Then
            cpt = cpt + 1
        End If
    Next

Call dossierSW

End sub

Private Sub dossierSW() 'procédure pour afficher les fichiers correspondant aux finitions

Dim nom As String
lign = 2
Dim colonneA As Range
Set colonneA = Acolon

    For Each cell In colonneA
        nom = cells(lign, 2)
        Select Case True
            Case nom Like "INT.PAP*", nom Like "@INT.PAP*": cells(lign, 7) = "Mé"
            Case nom Like "PAP.ENR*", nom Like "@PAP.ENR*", nom Like "PAP." & "*ENR*", nom Like "@PAP." & "*ENR*": cells(lign, 7) = "enrs"
            Case nom Like "PAP*", nom Like "@PAP*": cells(lign, 7) = "Pap"
            Case nom Like "": cells(lign, 7) = ""
        End Select
        lign = lign + 1
    Next

    lign = 2

End Sub

Bonjour @3GB je reviens sur ce sujet :

Pour éviter que les noms d'en-têtes ne soient changés, vous pouvez protéger la feuille. Sinon, s'il n'y a pas d'autres insertions de colonnes prévues, vous pouvez éventuellement ajouter ce code dans le module de la feuille concernée :

private sub worksheet_change(byval target as range)

dim titres

titres = Array("Titrecol1", ..., "Titrecoln") 'fixés en dur dans le code

if not intersect(target, Range(NOMTABLEAU[#Headers])) is nothing then 'si un titre est modifié

application.enableevents = False 'désactive évènements

Range(NOMTABLEAU[#Headers]).value = titres 'remet les bons titres (donc empêche chgt)

application.enableevents = True 'réactive évènements

end if

end sub

faut-il que je remplace quelque chose dans le [#Headers] car j'ai bien mis le nom de mon tableau mais les deux lignes concernées restent en rouge ...

UPDATE : J'ai résolu l eroblème il manquait des ".."

Salut Man,

C'est bien parce que tu fais les questions et les réponses !

Oui, parfois je ne suis pas assez assidu dans mes exemples mais en effet, il faut mettre le tout entre guillemets (comme avec la fonction INDIRECT).

A plus,