1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
| Sub Caunois()
'
' Caunois Macro
' Macro enregistrée le 16/02/2006 par boutteau
'
'
LeNom = ActiveWorkbook.Name
Workbooks.Add
ChDir "C:\Documents and Settings\boutteau\Bureau"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\boutteau\Bureau\GrapheQualTTH.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveCell.FormulaR1C1 = "NumCommande"
Range("B1").Select
Columns("A:A").ColumnWidth = 16
Range("B1").Select
ActiveCell.FormulaR1C1 = "Min/Max"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Valeur "
Range("D1").Select
ActiveCell.FormulaR1C1 = ""
Windows(LeNom).Activate
Windows("GrapheQualTTH.xls").Activate
ActiveCell.FormulaR1C1 = "Lot"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Coulee"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Test"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Lot/Coulee/Test"
Range("D2").Select
Columns("G:G").ColumnWidth = 15.14
Windows(LeNom).Activate
Range("H11").Select
Selection.Copy
Windows("GrapheQualTTH.xls").Activate
Range("A2").Select
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = False
Range("A1").Select
Selection.Font.Bold = True
Range("B1").Select
Selection.Font.Bold = True
Range("C1").Select
Selection.Font.Bold = True
Range("D1").Select
Selection.Font.Bold = True
Range("E1").Select
Selection.Font.Bold = True
Range("F1").Select
Selection.Font.Bold = True
Range("G1").Select
Selection.Font.Bold = True
Range("B2").Select
Windows(LeNom).Activate
Range("G17").Select
Selection.Copy
Windows("GrapheQualTTH.xls").Activate
Range("B2").Select
ActiveSheet.Paste
Windows(LeNom).Activate
Range("G18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("GrapheQualTTH.xls").Activate
Range("B3").Select
ActiveSheet.Paste
Range("B2:B3").Select
Selection.Font.Bold = False
Windows(LeNom).Activate
Range("G20", [G20].End(xlDown)).Select
Selection.Copy
Windows("GrapheQualTTH.xls").Activate
Range("C2").Select
ActiveSheet.Paste
Selection.Font.ColorIndex = 1
Range("C2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.ColorIndex = 1
Range("D2").Select
Windows(LeNom).Activate
Range("F20", [F20].End(xlDown)).Select
Selection.Copy
Windows("GrapheQualTTH.xls").Activate
ActiveSheet.Paste
Windows(LeNom).Activate
Range("E20", [E20].End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("GrapheQualTTH.xls").Activate
Range("E2").Select
ActiveSheet.Paste
Windows("Fichier Type.xls").Activate
Range("D20", [D20].End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("GrapheQualTTH.xls").Activate
Range("F2").Select
ActiveSheet.Paste
Range("G2").Select
Application.CutCopyMode = False
Range("G2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],""/"",RC[-2],""/"",RC[-1])"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2", [F2].End(xlDown)), Type:=xlFillDefault
Range("G2", [F2].End(xlDown)).Select
End Sub |
Partager