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
| Sub APPELTRESO()
'Permet d'effectuer la macro testfacture sur toutes les lignes de la feuille FACTURATION
LigneDebut = 2
LigneFin = 19
If vbNo = MsgBox("Voulez-vous editez les factures des comités ?" & vbNewLine & "FDSVO", vbYesNo, "FACTURATION COMITES") Then
MsgBox ("Demande de facture annulée"), vbInformation, "FACTURATION COMITES"
Exit Sub
Else
numero = InputBox("Entrez le numéro de la première facture", "NUMERO DE FACTURE")
Sheets("FACTRESO").Visible = True
Sheets("FACTRESO").Select
For i = LigneDebut To LigneFin
Range("G21").Value = "202500" & numero
facturetreso (i)
numero = numero + 1
Next i
Sheets("FACTRESO").Select
ActiveWindow.SelectedSheets.Visible = False
MsgBox "Facture éditées.", vbInformation, "FACTURATION COMITE"
End If
End Sub
Sub facturetreso(MaLigne As Long)
'
' factureres Macro
' Edition de la facture trésorerie au format PDF et impression
Dim Nomfic As String
'Stop
A = (Year(Date))
B = " TRESO "
If Sheets("COMITE").Cells(MaLigne, 17).Value >= 100 Then
Sheets("FACTRESO").Range("E10").Value = Sheets("COMITE").Cells(MaLigne, 3).Value
Range("E7").FormulaR1C1 = ("=COMITE!R" & MaLigne & "C1")
Range("F7").FormulaR1C1 = ("=COMITE!R" & MaLigne & "C2")
Range("F7").Copy
Range("F10").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("E8").FormulaR1C1 = ("=COMITE!R" & MaLigne & "C4")
Range("E9").FormulaR1C1 = ("=COMITE!R" & MaLigne & "C5")
Range("C20").FormulaR1C1 = ("=COMITE!R" & MaLigne & "C13")
Range("G26").FormulaR1C1 = ("=COMITE!R" & MaLigne & "C17")
Range("F7").Select
Sheets("FACTRESO").PrintOut
Nomfic = ActiveCell.Value & " " & B & A
With Sheets("FACTRESO")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Marc\Documents\ACTIV\SPF\FACTURE" & Nomfic _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End With
Range("F7").ClearContents
Range("E7").ClearContents
Range("E8").ClearContents
Range("E9").ClearContents
Range("E10").ClearContents
Range("F10").ClearContents
Range("C20").ClearContents
Range("G21").ClearContents
Range("G26").ClearContents
Else
End If
'Stop
End Sub |
Partager