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
|
Sub SAVE_RECU_FISCAL_1()
'
'Ecriture dans le formulaire PDF Recu Fiscal
'Sauvegarde du PDF
'
Dim AVDoc As Object '' VAR pour ecrire dans Reçu Fiscal PDF
Dim sChemin As String '' VAR pour ecrire dans Reçu Fiscal PDF
Dim PDDoc As Object '' VAR pour ecrire dans Reçu Fiscal PDF
Dim JSO As Object '' VAR pour ecrire dans Reçu Fiscal PDF
Dim nomfichierRECU As String '' nom de variable recuperant le chemin du fichier Recçu Fiscal PDF
Dim nomfeuilleRef As String ''nom de la feuille NDF de r_f_rence
Dim numdeligneRef As Integer '' Num_ro de ligne de la Note de Frais
Dim yourmsgbox As String
Dim TestPC As String '' Test du systeme d'exploitation (WIN ou MAC)
'''''''
''''''' CONFIGURATION
nomfeuilleRef = "NDF 1"
numdeligneRef = 12
'''''''
'''''''
If FlagMsgRF = 1 Then GoTo SauterMsg1
' Boite de dialogue
yourmsgbox = msgbox("Cette operation peut prendre plusieurs minutes." & vbNewLine & "Voulez-vous continuer ?", vbYesNo, "Demande de confirmation")
If yourmsgbox = vbNo Then
msgbox "Generation du Recu Fiscal annulee"
Exit Sub
End If
SauterMsg1:
' Stop rafraichissement ecran
Application.ScreenUpdating = False
' Test du systeme d'exploitation Windows ou Mac
TestPC = (Application.OperatingSystem)
TestPC = Left(TestPC, 3)
'''''''''' Ecriture du reçu fiscal en PDF + sauvegarde
If TestPC = "Mac" Then
Set AVDoc = CreateObject("AcroExch.AVDoc")
sChemin = ThisWorkbook.Path & ":" & "Recu_fiscal_ELECTROSMILE_Vierge.pdf"
End If
If TestPC = "Win" Then
Set AVDoc = CreateObject("AcroExch.AVDoc")
sChemin = ThisWorkbook.Path & "\" & "Recu_fiscal_ELECTROSMILE_Vierge.pdf"
End If
If AVDoc.Open(sChemin, "") Then
Set PDDoc = AVDoc.GetPDDoc
Set JSO = PDDoc.GetJSObject
''' Ecriture des informations dans le PDF
JSO.getField("Numb").Value = Sheets("Configuration et Mode d'emploi").Range("A22") & Sheets("Configuration et Mode d'emploi").Range("A21") & Sheets("Liste NDF General").Cells(numdeligneRef, 2)
JSO.getField("Nom").Value = Sheets("Configuration et Mode d'emploi").Cells(6, 2).Value
JSO.getField("Prenom").Value = Sheets("Configuration et Mode d'emploi").Cells(7, 2).Value
JSO.getField("Adresse").Value = Sheets("Configuration et Mode d'emploi").Cells(8, 2).Value
JSO.getField("Code Postal").Value = Sheets("Configuration et Mode d'emploi").Cells(9, 2).Text
JSO.getField("Commune").Value = Sheets("Configuration et Mode d'emploi").Cells(10, 2).Value
JSO.getField("Montant").Value = Sheets(nomfeuilleRef).Cells(39, 1).Text
JSO.getField("Montantlettres").Value = SpellNumber(Sheets(nomfeuilleRef).Cells(25, 5).Value)
JSO.getField("DateDonJour").Value = Sheets("Generation RecusF").Cells(3, 2).Text
JSO.getField("DateDonMois").Value = Sheets("Generation RecusF").Cells(3, 3).Text
JSO.getField("DateDonAnnee").Value = Sheets("Generation RecusF").Cells(3, 4).Text
JSO.getField("DateSignJour").Value = Sheets("Generation RecusF").Cells(3, 2).Text
JSO.getField("DateSignMois").Value = Sheets("Generation RecusF").Cells(3, 3).Text
JSO.getField("DateSignAnnee").Value = Sheets("Generation RecusF").Cells(3, 4).Text
' Definition du nom du fichier
nomfichierRECU = "RECUFISCAL_" & Sheets("Configuration et Mode d'emploi").Range("B3") & "_" & Sheets("Liste NDF General").Cells(numdeligneRef, 2) & "_" & Sheets(nomfeuilleRef).Range("F4") & "_" & Sheets(nomfeuilleRef).Range("E25") & "_Euro" & ".pdf"
' Sauvegarde du fichier
PDDoc.Save 1, ThisWorkbook.Path & "\" & nomfichierRECU
PDDoc.Close
Set JSO = Nothing
Set PDDoc = Nothing
End If
Set AVDoc = Nothing
SendKeys ("%{F4}") 'envoi altF4 pour fermer le PDF juste ouvert (+ desactive le pave numerique :()
' Indicateur de generation du Recu Fiscal
Sheets("Generation RecusF").Range("A14").Interior.Color = RGB(0, 255, 0) ' Remplissage cellule du bouton en vert
Sheets("Generation RecusF").Range("B16").Value = Sheets("Generation RecusF").Range("B4").Value ' Ecriture de la date de generation dans la cellule correspondante
Sheets("Liste NDF General").Cells(numdeligneRef, 90).Value = Sheets("Generation RecusF").Range("B4").Value ' Ecriture de la date de generation dans la cellule correspondante
'''' Fin Ecriture du reçu fiscal en PDF + sauvegarde
' Selection onglet maitre
Sheets("Generation RecusF").Select
' Reactiver rafraichissement ecran
Application.ScreenUpdating = True
If FlagMsgRF = 1 Then GoTo SauterMsg2
' Boite de dialogue
msgbox "Sauvegarde effectuee ici :" & vbNewLine & vbNewLine & ThisWorkbook.Path
SauterMsg2:
End Sub |
Partager