Tester si une plage existe

Anthonymctm

XLDnaute Occasionnel
Bonjour à tous ! :D

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
 

Pièces jointes

  • Test XL-WD (1).xlsm
    491.2 KB · Affichages: 6

pierrejean

XLDnaute Barbatruc
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
 

pierrejean

XLDnaute Barbatruc
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

XLDnaute Occasionnel
Super, merci ! :D

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
 

Anthonymctm

XLDnaute Occasionnel
Ecoute ça à l'air top ! merci beaucoup :eek:

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 o_O
 
Haut Bas