Re : Une macro dans une macro
Voici le fichier en question : En case H1 je souhaite insérer un numéro de manifeste en automatique à chaque fois que je lance la macro. Le format souhaité de ce numéro de dossier est : 00001 15 12 E LITE soit : numéro qui se suivent plus année plus mois plus E lite.
Merci de votre aide
Ci dessous la macro : du fichier au quel il faudrait ajouter la macro d ajout de numéro de manifest.
Sub MANIFESTELITE2015()
'
' MANIFESTELITE2015 Macro
'
'
Columns("A:V").Select
Columns("A:V").EntireColumn.AutoFit
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll ToRight:=6
Columns("M:M").ColumnWidth = 54.86
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Range("A1:N1").Select
Range("N1").Activate
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:4").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H2").Select
Columns("A:A").ColumnWidth = 15.71
Range("A1").Select
ActiveCell.FormulaR1C1 = "AGREMENT PDE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "N°60"
Range("A2").Select
ActiveCell.FormulaR1C1 = "DATE MANIFEST"
Range("B2:C2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "=NOW()"
Range("B2:C2").Select
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
Range("A3").Select
ActiveCell.FormulaR1C1 = "BUREAU DE DOUANE"
Range("C3").Select
ActiveCell.FormulaR1C1 = "CDGSF1 ""WFS"""
Range("A4").Select
ActiveCell.FormulaR1C1 = "MAWB"
Range("B4").Select
Selection.NumberFormat = "000-0000-0000"
Range("D1:G1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "MANIFEST LINEX E LITE N°"
Range("D1:G1").Select
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H1").Select
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("E2").Select
ActiveCell.FormulaR1C1 = "VOL"
Range("F2").Select
ActiveCell.FormulaR1C1 = "CX 260"
Range("E3").Select
ActiveCell.FormulaR1C1 = "REPRESENTATION"
Range("G3").Select
ActiveCell.FormulaR1C1 = "RI"
Range("H2").Select
ActiveCell.FormulaR1C1 = "FROM CDG TO CHINA"
Range("K1").Select
ActiveCell.FormulaR1C1 = "NOMBRE DE SACS"
Range("K2").Select
ActiveCell.FormulaR1C1 = "POIDS"
Range("K3").Select
ActiveCell.FormulaR1C1 = "NOMBRE DE POSITIONS"
Range("B4").Select
With Selection.Font
.Name = "Calibri"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&P / &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 60
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ChDir _
"\\SERVL2008\Tarifs et services LINEX\DOUANE\MANIFEST & MACRO MANIFEST E COMMERCE"
ActiveWorkbook.SaveAs Filename:= _
"\\SERVL2008\Tarifs et services LINEX\DOUANE\MANIFEST & MACRO MANIFEST E COMMERCE\Shipment (12).xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Range("H1").Select
End Sub
