Tester si une plage existe

Anthonymctm

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: 9
Trier par date Trier par votes
pierrejean

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
 
Vote positif 0 Vote négatif
pierrejean

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
 
Vote positif 0 Vote négatif
Anthonymctm

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
 
Vote positif 0 Vote négatif
Anthonymctm

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
 
Vote positif 0 Vote négatif

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
931
Nicolas JACQUIN
Nicolas JACQUIN
N
  • Résolu(e)
XL 2019 Aide macro on error resume
Réponses
3
Affichages
516
netparty
N
L
  • Question
Microsoft 365 Copier graphes excel dans word
Réponses
0
Affichages
564
lestatber
L
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
421
guiyom
G
K
  • Question
Microsoft 365 Eporter donner d'un excel fermé vers excel de travail
Réponses
1
Affichages
572
Hasco
Hasco
A
  • Question
XL 2019 Résolu - Bug code VBA modifier xxx fichiers en boucle
Réponses
3
Affichages
599
fanch55
fanch55
Anthonymctm
  • Résolu(e)
[VBA] Coller en tant qu'image
Réponses
1
Affichages
2 K
Anthonymctm
Anthonymctm
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Vérifier si elle existe une copie identique
Réponses
2
Affichages
394
chaelie2015
chaelie2015
Anthonymctm
  • Question
XL 2016 VBA - Ajouter numéro de page en pied de page sur Word
Réponses
7
Affichages
2 K
Anthonymctm
Anthonymctm

Membres actuellement en ligne

6 membres et 127 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 719
Messages
2 112 179
Membres
111 452
dernier inscrit
christine64