Microsoft 365 Petit changement

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
 

Discussions similaires

Statistiques des forums

Discussions
298 001
Messages
1 965 026
Membres
200 809
dernier inscrit
Ksiba