Tester si une plage existe

Anthonymctm · 6 Août 2019

Bonjour à tous !

Bon, j'ai plusieurs points à régler sur ma macro dont je présente le besoin global ici : https://www.excel-downloads.com/threads/vba-export-excel-word.20034683/

Pour pouvoir avancer à petit pas, je vais essayer de régler ici un des points à régler.

Dans mon fichier Excel, j'ai une macro me permettant de générer des plages nommées qui vont bien dans 3 onglets.
Les plages se nomment page_01, page_02, etc. Il y a donc 3 plages nommées "page_01" (une par onglet).

A chaque fois que j'active cette macro, les plages se réinitialisent, et parfois, par exemple, je n'ai pas de page_02 sur le deuxième onglet.
Ce qui fait que mon autre macro qui fait référence à cette plage bug puisque cette plage n'existe pas. Il faut donc que je puisse tester en amont si la plage existe.

Voici le code actuel :

VB:

Sub export_excel_to_word()

    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile

    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add

' newObj.PageSetup.LeftMargin = CentimetersToPoints(1)
' newObj.PageSetup.RightMargin = CentimetersToPoints(1)
  On Error Resume Next
 
ThisWorkbook.Worksheets("En_tête").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
             
               .TypeParagraph
                .InsertBreak Type:=7
            End With
'Selection.InlineShapes(1).LockAspectRatio = msoTrue
'Selection.InlineShapes(1).Width = 498.9

ThisWorkbook.Worksheets("En_tête").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
ThisWorkbook.Worksheets("En_tête").Range("page_03").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With

ThisWorkbook.Worksheets("Descriptif").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With  
ThisWorkbook.Worksheets("Descriptif").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
ThisWorkbook.Worksheets("Descriptif").Range("page_03").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
ThisWorkbook.Worksheets("Descriptif").Range("page_04").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
ThisWorkbook.Worksheets("Descriptif").Range("page_05").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
           
ThisWorkbook.Worksheets("Carac_tech").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
ThisWorkbook.Worksheets("Carac_tech").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
           
   Application.CutCopyMode = False

    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile

    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"

    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing

End Sub

pierrejean · 6 Août 2019

Bonjour anthonymctm

une fonction personnalisée qui te dira si le nom existe

VB:

Function exist(nom As String) As Boolean
exist = False
On Error Resume Next
    x = ActiveWorkbook.Names(nom).RefersTo
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function

Anthonymctm · 6 Août 2019

Bonjour PierreJean,

Merci à toi

Comment je m'en sers ensuite dans ma macro ?

Comment je spécifie dans quel onglet se situe la plage nommée ?

pierrejean · 6 Août 2019

Re

lorsqu'il y a plusieurs noms identiques (ce qui n'est pas conseillé !!)
fonction exist et la manière de s'en servir:

VB:

Function exist(feuille As String, nom As String) As Boolean
exist = False
On Error Resume Next
    x = Sheets(feuille).Range(nom).Address
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function


Sub essai()
If exist("Descriptif", "page_02") Then
   'traitement
End If
End Sub

Anthonymctm · 7 Août 2019

Super, merci !

Ca fonctionne bien, par contre je sens que mon code va durer 3 plombes ^^'

VB:

Sub export_excel_to_word()
 
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
 
 ' newObj.PageSetup.LeftMargin = CentimetersToPoints(1)
 ' newObj.PageSetup.RightMargin = CentimetersToPoints(1)
  
ThisWorkbook.Worksheets("En_tête").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
              
               .TypeParagraph
                .InsertBreak Type:=7
            End With
'Selection.InlineShapes(1).LockAspectRatio = msoTrue
'Selection.InlineShapes(1).Width = 498.9

If exist("en_tête", "page_02") Then
ThisWorkbook.Worksheets("En_tête").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If

If exist("en_tête", "page_03") Then
ThisWorkbook.Worksheets("En_tête").Range("page_03").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If

ThisWorkbook.Worksheets("Descriptif").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
            
If exist("Descriptif", "page_02") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If

If exist("Descriptif", "page_03") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_03").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_04") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_04").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_05") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_05").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_06") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_06").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_07") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_07").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
            
            
   Application.CutCopyMode = False
 
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing
 
End Sub

Tu vois comment le raccourcir ?
En gros sur 2 de mes onglets, le nombre de plage va de 1 à 15 et si ya pas de page_03, il n'y aura pas de page_04 ou plus.
Bref le nombre le plus élevé détermine le nombre de plage nommées qu'il y aura sur cet onglet

pierrejean · 7 Août 2019

Re

A tester

Anthonymctm · 7 Août 2019

Ecoute ça à l'air top ! merci beaucoup

Si tu veux encore m'aider, j'ai encore 1 truc à modifier à chaque collage.

Il faut que j'arrive à modifier la largeur de ce qui est collé pour que ça fasse la même largeur que la page Word.

L’enregistreur de macro Word me donne ce code :

VB:

Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Width = 498.9

Mais évidemment, si je l'insère dans ma macro, ça ne fonctionne pas

Tester si une plage existe

Anthonymctm

XLDnaute Occasionnel

Pièces jointes

pierrejean

XLDnaute Barbatruc

Anthonymctm

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

Anthonymctm

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

Pièces jointes

Anthonymctm

XLDnaute Occasionnel

Discussions similaires