Microsoft 365 Petit changement

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

marine_volria

XLDnaute Nouveau
Bonjour à tous et à toutes,

J'ai cette macro qui tourne le problème c'est que ca m'en génère pleins d'autres vous le verrez par vous même dans le code de celle ci je n'arrive pas à la modifier pour que le résultats final soit le même. Mais que une seul macro portant le nom "generation_P_RO" contienne l'ensemble de ce programme et non pas comme actuellement "macro1 "macro2" ect ect... pourriez vous m'aider svp ?

VB:
Sub generation_R0_P()
'
' generation_R0_P Macro
'
End Sub
Sub Macro2()
    ActiveDocument.Save
  
    path1 = ActiveDocument.Path
    FileName = ActiveDocument.Name
  
    FileName = Left(FileName, Len(FileName) - 5)
  
    ChangeFileOpenDirectory path1 & "\"
    ActiveDocument.SaveAs2 FileName:=FileName & "-R0.docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
      
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        path1 & "\" & FileName & "-R0.pdf", ExportFormat:=wdExportFormatPDF, _
         OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
        wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
        IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
        wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
        True, UseISO19005_1:=False
      
    ActiveDocument.Save


End Sub
Sub Macro4()
    ActiveDocument.Save
  
    path1 = ActiveDocument.Path
    FileName = ActiveDocument.Name
  
    FileName = Left(FileName, Len(FileName) - 5)
  
    ChangeFileOpenDirectory path1 & "\"
    ActiveDocument.SaveAs2 FileName:=FileName & "-R1.docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
      
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        path1 & "\" & FileName & "-R1.pdf", ExportFormat:=wdExportFormatPDF, _
         OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
        wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
        IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
        wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
        True, UseISO19005_1:=False
      
    ActiveDocument.Save


End Sub

Sub Macro1()
    ActiveDocument.Save
  
    path1 = ActiveDocument.Path
    FileName = ActiveDocument.Name
  
    FileName = Left(FileName, Len(FileName) - 5)
  
    ChangeFileOpenDirectory path1 & "\"
    ActiveDocument.SaveAs2 FileName:=FileName & ".docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
      
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        path1 & "\" & FileName & ".pdf", ExportFormat:=wdExportFormatPDF, _
         OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
        wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
        IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
        wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
        True, UseISO19005_1:=False
      
    ActiveDocument.Save

End Sub
Sub insérerfilename()

    Selection.InsertBefore Text:=Left(ActiveDocument.Name, _
      Len(ActiveDocument.Name) - 5)

End Sub

Sub Macro9()
'
' Macro9 Macro
'
'
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.TypeBackspace
    Selection.HomeKey Unit:=wdLine
End Sub
Sub Macro10()
'
' Macro10 Macro
'
'
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
        :=True, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
End Sub
Sub Macro13()
'
' Macro13 Macro
'
'
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
        :=True, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
2 K
Retour