Plage de nom en VBA.

Bonjour,

Je cherche un moyen pour utiliser des variables lors de la création d'une plage de nom en VBA.
Si quelqu'un à des idées merci!

4 réponses

  1. Bonjour,

    Il faut plus de rigueur lorsque tu écris du code, quelques conseils :
    • commences tous les modules par Option Explicit, cela oblige à déclarer toutes les variables
    • déclares les variables avec le type ad hoc (pas toutes en Variant) ;
    • ne jamais utiliser .Select, éviter Selection, Activecell, Activesheet, ... ;
    • envisages toutes les valeurs potentielles des variables pour éviter les erreurs ;
    • évites d'utiliser des propriétés ou méthodes d'objet héritées qui pourraient ne pas exister,
    --- par exemple, au lieu de :
    Sheets(1).Range("A1")
    écrire
    Workheets(1).Range("A1")
    ,
        en effet l'objet Range n'appartient pas à Sheet mais à Worksheet ;
    • évites les références implicites, privilégies les références explicites,
    --- par exemple, au lieu de
    = Cells(1,2)
    écrire
    = Worksheets(1).Cells(1,2).Value
    ;
    • donc, précises toujours la feuille pour un objet Range (Cells, Rows, ...) et la propriété cible (Value, Text, ...)
    • éviter si possible d'utiliser le Presse-Papier

    Ceci dit, je ne suis pas sûr d'avoir compris ce que tu veux comme nom !

    Essaies ce code :
    Option Explicit
    Sub macro2()
    Dim F As Worksheet      'Feuille
    Dim a As String         'Réponse a
    Dim b As String         'Réponse b
    Dim P As Long           'Première ligne
    Dim D As Long           'Dernière ligne
    Dim L As Long           'Ligne
    Dim C As Long           'Colonne
    Dim E As Boolean        'Erreur nombre de feuille
    
      a = InputBox("Saisir le numéro de la première ligne :", "Insertion d'un nouveau marché", 0)
      b = InputBox("Saisir le numéro de la dernière ligne :", "Insertion d'un nouveau marché", 0)
      P = Val(a)
      D = Val(b)
      If P = 0 Or D = 0 Or D < P Then Exit Sub
      If P <= Worksheets.Count Then E = True
      Set F = ActiveSheet   'ou une autre feuille par exemple Worksheet("Feuil1")
      With F
        .Rows(P).Resize(D - P + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        With .Rows(P).Resize(D - P + 1)
          For C = 3 To 5
            With .Columns(C).Cells
              .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlCenter
              .WrapText = True
              .MergeCells = True
            End With
          Next C
          With .Columns(3).Resize(, 9).Cells.Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
          End With
        End With
      End With
      If E Then
        Set F = Worksheets(P)
        With F.Names
          .Add Name:="NewL", RefersToR1C1:="='" & F.Name & "'!R" & P & "C12:R" & D & "C12"
          .Add Name:="NewM", RefersToR1C1:="='" & F.Name & "'!R" & P & "C13:R" & D & "C13"
          .Add Name:="NewP", RefersToR1C1:="='" & F.Name & "'!R" & P & "C16:R" & D & "C16"
        End With
      Else
        MsgBox "Impossible de créer les noms dans la " & E & "° feuille" & vbCrLf & _
               vbCrLf & _
               "Elle n'existe pas !", vbCritical
      End If
    End Sub

    0
    1. Voila le code que j'ai fais,
      L'utilisateur saisi les lignes où il souhaite insérer des lignes, puis le vba sert à créer 3 plages dans les lignes insérer, théoriquement! mais cela ne marche pas :/
      Y aurait-il une solution?
      Merci!

      Sub macro2()
      i = InputBox("Renter la numéro de la première ligne: ", "Insertion d'un nouveau marché", 0)
      j = InputBox("Renter la numéro de la dernière ligne: ", "Insertion d'un nouveau marché", 0)
      MsgBox i
      MsgBox j
      k = j - i
      m = i
      ActiveSheet.Select
      For l = 1 To k
      Rows(m).Select
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      m = m + 1
      Next
      Range(Cells(i, 3), Cells(j, 3)).Select
      With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      End With
      Selection.Merge
      Range(Cells(i, 4), Cells(j, 4)).Select

      With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      End With
      Selection.Merge
      Range(Cells(i, 5), Cells(j, 5)).Select
      With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      End With
      Selection.Merge
      Range(Cells(i, 6), Cells(i, 15)).Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlThin
      End With
      Selection.Borders(xlEdgeTop).LineStyle = xlNone
      With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlThin
      End With
      With Selection.Borders(xlEdgeRight)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlThin
      End With
      With Selection.Borders(xlInsideVertical)
      .LineStyle = xlContinuous
      .ColorIndex = 0
      .TintAndShade = 0
      .Weight = xlThin
      End With
      Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
      Range(Cells(i, 12), Cells(j, 12)).Select
      ActiveWorkbook.Worksheets(i).Names.Add Name:="NewL", _
      RefersToR1C1:="=i!RjC12:RiC12"
      ActiveWorkbook.Worksheets(i).Names("NewL").Comment = ""
      Range(Cells(i, 13), Cells(j, 13)).Select
      ActiveWorkbook.Worksheets(i).Names.Add Name:="NewM", _
      RefersToR1C1:="=i!RiC13:RjC13"
      ActiveWorkbook.Worksheets(i).Names("NewM").Comment = ""
      Range(Cells(i, 16), Cells(j, 16)).Select
      ActiveWorkbook.Worksheets(i).Names.Add Name:="NewP", _
      RefersToR1C1:="=i!RiC16:RjC16"
      ActiveWorkbook.Worksheets(i).Names("NewP").Comment = ""
      End Sub
      0