Discussion :

[arthemusmacaulay]

Bonjour,

Je voudrais ajouter des noms de plages incrémentés sur chaque range A7:A400, B7:B400, etc .... et les nommer "dropZ1A","dropZ1B", etc ... 1 étant l'index de la feuille et la lettre, la lettre de la colonne, ceci automatiquement via macro avec le code suivant :

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
Sub BuildRefNames()
On Error GoTo err
 
1  Dim nRowDeb As Byte: nRow = 7
2  Dim nRowFin As Integer: nCol = 400
 
3  Feuil1.Activate
4  For Each c In Feuil1.Columns
5      MsgBox c.Column & " : " & c.Address
6 '      c.Range(Cells(nRow, c.Column), Cells(nCol, c.Column)).Select
7 '      Selection.Name = "dropZ" & Feuil1.Index & lettrecolumns(c.Column)
8      c.Range(Cells(nRowDeb, c.Column), Cells(nRowFin, c.Column)).Name = "dropZ" & Feuil1.Index & lettrecolumns(c.Column)
9    Next
 
  Exit Sub
 
err:
  MsgBox ("erreur n° " & err.Number & " à la ligne " & Erl() & ", " & err.Description)
  Resume Next
End Sub
 
Function lettrecolumns(l As Integer)
On Error GoTo err
 
    lettrecolumns = Split(Columns(l).Address(ColumnAbsolute:=False), ":")(1)
 
    Exit Function
 
err:
    lettrecolumns = "#"
    Resume Next
    'Val(Mid(Columns("AF").Address(ReferenceStyle:=xlR1C1), 2))
End Function

Mon problème est que malgré qu' à la ligne 5 les datas soient correctes 1 : $A:$A, 2 : $B:$B, etc ..., les noms de plages sont attribués comme suit :

dropZ1A ==> '=Feuil1!$A$7:$A$400'
dropZ1B ==> '=Feuil1!$C$7:$C$400'
dropZ1C ==> '=Feuil1!$E$7:$E$400'
dropZ1D ==> '=Feuil1!$G$7:$G$400'
....

Vous avez compris , une colonne est ignorée à chaque passage dans la boucle.Pourtant, each veut bien dire each ...
Vous vous doutez bien que j'ai essayé bcp d'écriture d'objets différentes dans le each mais rien à faire ...
Rq : Si on spécifie la colonne entière, là par contre çà fonctionne et pas de colonne sur 2 ignorée ...

Merci

[kiki29]

Salut, déjà pour la fonction si col > 256..., supprime les on error goto, ensuite Il est souhaitable de baliser ton code, reconstruit ta procédure bric à brac.

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Function NumCol2Lettre(iNumCol As Long) As String
Dim i As Long, sStr As String
    i = iNumCol
    sStr = ""
    Do While i > 0
        sStr = Chr$(((i - 1) Mod 26) + 65) & sStr
        i = (i - 1) \ 26
    Loop
    NumCol2Lettre = sStr
End Function

[kiki29]

Re, pour le reste

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
Option Explicit
 
Sub NommerPlages()
Dim iRowDeb As Long, iRowFin As Long
Dim iColDeb As Long, iColFin As Long
Dim sFeuille As String, Wsh As Worksheet, Wkb As Workbook
Dim i As Long, sNom As String, sPlage As String, sCol As String
 
    iRowDeb = 7
    iRowFin = 400
 
    iColDeb = 1
    iColFin = 256
 
    sFeuille = "Feuil1"
    Set Wkb = ActiveWorkbook
 
    If FeuilleExiste(Wkb.Name, sFeuille) Then
        Set Wsh = Worksheets(sFeuille)
        Wsh.Activate
        For i = iColDeb To iColFin
            sCol = NumCol2Lettre(i)
            sNom = "DropZ" & Wsh.Index & sCol
            sPlage = "=" & Wsh.Name & "!$" & sCol & "$" & iRowDeb & ":$" & sCol & "$" & iRowFin
            Wkb.Names.Add Name:=sNom, RefersTo:=sPlage, Visible:=True
        Next i
        Set Wsh = Nothing
    Else
        MsgBox sFeuille & " inexistante sur " & Wkb.Name
    End If
    Set Wkb = Nothing
End Sub

[kiki29]

Re, sans oublier ceci qui peut être utile.

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
Sub ToutSupprimer()
Dim Nom As Name, Wkb As Workbook
Dim Cpt As Long
Dim sRep As String, bPrintAreas As Boolean
 
    Set Wkb = ActiveWorkbook
 
    sRep = MsgBox("Préserver les noms des zônes d'impression ?", _
                  vbQuestion + vbYesNoCancel + vbDefaultButton1)
    If sRep = vbYes Then bPrintAreas = True
    If sRep = vbCancel Then Exit Sub
 
    For Each Nom In Wkb.Names
        On Error GoTo Skip
        If bPrintAreas And Right$(Nom.Name, 10) = "Print_Area" Then GoTo Skip
        Nom.Delete
        Cpt = Cpt + 1
Skip:
    Next Nom
    On Error GoTo 0
    Set Wkb = Nothing
    Application.StatusBar = "[" & Cpt & "] noms effacés."
End Sub

[arthemusmacaulay]

Merci de vos réponses, çà fonctionne mais cela ne répond pas totalement à ma question càd la non prise en compte d'une colonne sur 2 en bouclant sur l'objet worksheet.column en nommant un range.

Cordialement

[kiki29]

Salut, tu es sur que tout fonctionne ? car il manque une petite partie. Une fonction vérifiant l'existence de la feuillle visée pour le classeur concerné.

Cela ne te dispense pas de baliser ton code du post 1

Code :

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

1
2
3
4
5
Private Function FeuilleExiste(sClasseur As String, sFeuille As String) As Boolean
Dim v As Variant
    v = Evaluate("ISREF('[" & sClasseur & "]" & sFeuille & "'!A1)")
    FeuilleExiste = IIf(IsError(v), False, v)
End Function