Re : Impression de fichier
Voici ce que j'ai trouvé :
Sub impression()
'
' impression Macro
Sheets("Rapport_2").Select
Dim i As Integer, sac As Integer, vrac As Integer, test As Integer, testn As Integer, derlig As Integer
Dim varsac As Double, varvrac As Double, vartest As Double, vartestn As Double
Dim vardata1(1000) As Double
Dim vardata2(1000) As Double
Dim vardata3(1000) As Double
Dim vardata4(1000) As Double
Range("a1:c65536").Clear
sac = 1
vrac = 1
test = 1
testn = 1
varsac = 0
varvrac = 0
vartest = 0
vartestn = 0
derlig = Sheets("Feuil2").Range("a65536").End(xlUp).Row
For i = 2 To derlig 'creation tableau
Select Case Sheets("Feuil2").Cells(i, 1).Value
Case Is = "SAC 1-2"
vardata1(sac) = Sheets("Feuil2").Cells(i, 2).Value
varsac = varsac + vardata1(sac)
sac = sac + 1
Case Is = "VRAC 1-2"
vardata2(vrac) = Sheets("Feuil2").Cells(i, 2).Value
varvrac = varvrac + vardata2(vrac)
vrac = vrac + 1
Case Is = "TEST BRUT"
vardata3(test) = Sheets("Feuil2").Cells(i, 2).Value
vartest = vartest + vardata3(test)
test = test + 1
Case Is = "TEST NET"
vardata4(testn) = Sheets("Feuil2").Cells(i, 2).Value
vartestn = vartestn + vardata4(testn)
testn = testn + 1
End Select
Next
lig = 2 'recopie sac
col = 1
Range("a1:c1").Interior.Color = 65535
Range("a1").Value = "IDENTIFICATION SAC 1-2"
i = 1
While i <> sac
Cells(lig, col).Value = vardata1(i)
i = i + 1
col = col + 1
If col > 10 Then
col = 1
lig = lig + 1
End If
Wend
Cells(lig + 1, 1).Interior.Color = 65535
Cells(lig + 1, 1).Value = "Total"
Cells(lig + 1, 2).Value = varsac
Cells(lig + 3, 2).Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Range(Cells(lig + 3, 1), Cells(lig + 3, 3)).Interior.Color = 65535
Cells(lig + 3, 1).Value = "IDENTIFICATION VRAC 1-2"
lig = lig + 4
col = 1
i = 1 'recopie vrac
While i <> vrac
Cells(lig, col).Value = vardata2(i)
i = i + 1
col = col + 1
If col > 10 Then
col = 1
lig = lig + 1
End If
Wend
Cells(lig + 1, 1).Interior.Color = 65535
Cells(lig + 1, 1).Value = "Total"
Cells(lig + 1, 2).Value = varvrac
Cells(lig + 3, 2).Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Range(Cells(lig + 3, 1), Cells(lig + 3, 3)).Interior.Color = 65535
Cells(lig + 3, 1).Value = "IDENTIFICATION TEST BRUT"
lig = lig + 4
col = 1
i = 1
While i <> test
Cells(lig, col).Value = vardata3(i)
i = i + 1
col = col + 1
If col > 10 Then
col = 1
lig = lig + 1
End If
Wend
Cells(lig + 1, 1).Interior.Color = 65535
Cells(lig + 1, 1).Value = "Total"
Cells(lig + 1, 2).Value = vartest
Cells(lig + 3, 2).Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Range(Cells(lig + 3, 1), Cells(lig + 3, 3)).Interior.Color = 65535
Cells(lig + 3, 1).Value = "IDENTIFICATION TEST NET"
lig = lig + 4
col = 1
i = 1
While i <> testn
Cells(lig, col).Value = vardata4(i)
i = i + 1
col = col + 1
If col > 10 Then
col = 1
lig = lig + 1
End If
Wend
Cells(lig + 1, 1).Interior.Color = 65535
Cells(lig + 1, 1).Value = "Total"
Cells(lig + 1, 2).Value = vartestn
Sheets("Rapport_2").PageSetup.LeftHeader = Sheets("Feuil1").[D1]
End Sub
Merci