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
|
Sub Macro1()
'
' Macro1 Macro
'
Dim I As Integer
I = Feuil1.Range("a1").End(xlDown).Row
nbcel = 0
nbcel1 = 0
' effacement des ancienne données
Sheets("Rapport générer").Select
Range("A20").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
' Copie tableau de la boite noire
Sheets("Feuil1").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Rapport générer").Select
Range("A20").Select
ActiveSheet.Paste
Range("A20").Select
' Calcul de l'offset horraire avec fusionnage celulle
For Each cel In Range("a20:a" & I + 20)
If cel <> "" Then
nbcel1 = nbcel + 20
Range(Cells(nbcel1, 2), Cells(nbcel1, 5)).Merge
Range("A" & nbcel1).Select
nbcel = nbcel + 1
ActiveCell.Formula = "=Feuil1!A" & nbcel & " - Feuil1!$F$3"
End If
Next cel
' Cadrillage Celulle
Range("A20").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("H27").Select
End Sub |
Partager