Re : saisie modification et Email
J'ai besoin de ton aide, j'ai suivi tes consignes pour la macro mais, j'ai un message d'erreur (erreur de compilation, variable non définie)
sur le texte en rouge (mail =)
Option Explicit
Dim lig As Integer, cel As Range, tot
Private Sub CmbRech_Change()
With Feuil2.Range("a2:a65536")
Set cel = .Find(Me.CmbRech, , xlValues, xlWhole)
If Not cel Is Nothing Then
Me.TextBox2 = cel.Offset(0, 0) 'Nom
Me.TextBox1 = Format(cel.Offset(0, 5), "dd.mm.yyyy") 'Date de paiement
Me.TextBox3 = cel.Offset(0, 1) 'Adresse mail
Me.ComboBox1 = cel.Offset(0, 3) 'N° de parking
Me.ComboBox2 = cel.Offset(0, 4) 'Mode de paiement
Me.TextBox4 = Replace(Me.TextBox4, ",", ".") 'Montant HT
Me.TextBox4 = Format(cel.Offset(0, 6), "0.00")
Feuil1.Range("i14") = cel.Offset(0, 6)
Feuil1.Range("i16") = cel.Offset(0, 7)
End If
End With
End Sub
Private Sub CmdModif_Click()
With Feuil2.Range("a2:a65536")
Set cel = .Find(Me.CmbRech, , xlValues, xlWhole)
If Not cel Is Nothing Then
cel.Offset(0, 0) = Me.TextBox2 'Nom
cel.Offset(0, 1) = Me.TextBox3 'Adresse mail
cel.Offset(0, 2) = Feuil1.Range("e3") 'Date d'enregistrement
cel.Offset(0, 3) = Me.ComboBox1 'N° de parking
cel.Offset(0, 4) = Me.ComboBox2 'Mode de paiement
cel.Offset(0, 5) = Me.TextBox1 'Date paiement
cel.Offset(0, 6) = Me.TextBox4 'Montant HT
cel.Offset(0, 6) = Format(Me.TextBox4, "# ##0.00\ €")
cel.Offset(0, 7) = cel.Offset(0, 6) * (Feuil1.Range("i15").Value + 1)
cel.Offset(0, 7) = Format(cel.Offset(0, 7), "# ##0.00\ €")
Feuil1.Range("f4") = Me.TextBox1
Feuil1.Range("c10") = Me.TextBox3
Feuil1.Range("f12") = Me.ComboBox1
Feuil1.Range("f14") = Me.ComboBox2
Feuil1.Range("i14") = cel.Offset(0, 6)
Feuil1.Range("i16") = cel.Offset(0, 7)
End If
End With
End Sub
Private Sub CmdQuitter_Click()
Unload Me
End Sub
Private Sub CmdValider_Click()
With Feuil1
.Range("c3") = .Range("c3") + 1
.Range("e3") = Date
.Range("f4") = Me.TextBox1
.Range("c8") = Me.TextBox2
If Me.TextBox3 Like "*@*.*" Then Feuil1.Range("c10") = Me.TextBox3
.Range("f12") = Me.ComboBox2
.Range("f14") = Me.ComboBox1
.Range("i14") = Format(Me.TextBox4, "# ##0.00\ €")
.Range("i16") = Me.TextBox4 * (.Range("i15").Value + 1)
.Range("i16") = Format(.Range("i16"), "# ##0.00\ €")
End With
With Feuil2
lig = .Range("a655236").End(xlUp).Row + 1
.Cells(lig, 1) = Me.TextBox2 'Nom
.Cells(lig, 2) = Me.TextBox3 'Adresse mail
.Cells(lig, 3) = Feuil1.Range("e3") 'Date d'enregistrement
.Cells(lig, 4) = Me.ComboBox1 'N° de parking
.Cells(lig, 5) = Me.ComboBox2 'Mode de paiement
.Cells(lig, 6) = Me.TextBox1 'Date paiement
.Cells(lig, 7) = Format(Me.TextBox4, "# ##0.00\ €") 'Montant HT
.Cells(lig, 8) = Format(Feuil1.Range("i16"), "# ##0.00\ €") 'Montant TTC
.Range("A:H").Columns.AutoFit
End With
Call EnvoisMail
End Sub
Private Sub TextBox1_AfterUpdate()
Me.TextBox1 = Format(Me.TextBox1, "dd.mm.yyyy")
End Sub
Private Sub TextBox3_AfterUpdate()
If Me.TextBox3 Like "*@*.*" Then
Me.TextBox3 = Me.TextBox3
Else
MsgBox "Ce n'est pas une adresse mail valide", , "PARKING"
Me.TextBox3 = ""
End If
End Sub
Private Sub UserForm_Activate()
Me.CmbRech = ""
End Sub
Private Sub UserForm_Initialize()
Dim x As Long, j As Integer
With Feuil2
For j = 2 To .Range("A65536").End(xlUp).Row
Me.CmbRech = .Range("A" & j)
If Me.CmbRech.ListIndex = -1 Then CmbRech.AddItem .Range("A" & j)
Next j
End With
With Me.ComboBox2
.AddItem "Cartes Bancaires"
.AddItem "Chèques"
.AddItem "Espèces"
End With
With Me.ComboBox1
For x = 1 To 8
.AddItem "Parking " & x
Next x
End With
End Sub
Private Sub EnvoisMail()
Dim OutlookApp As Object
Dim outlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set Mail = OutlookApp.CreateItem(0)
CurFile = ThisWorkbook.Path & "\" & Range("C3").Value & "_" & Range("C8").Value & ".Pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With Mail
.SentOnBehalfOfName = "ADRESSE@EMAIL"
.To = ActiveSheet.Range("C10").Text
.Subject = "Duplicata De Reçu "
.Body = olFormatHTML
.HTMLBody = "<br><br>" & GetBoiler("CHEMIN DU FICHIER SIGATURE HTM")
.Attachments.Add CurFile
.Send
End With
ActiveWorkbook.Save
If Workbooks.Count = 1 Then
Application.Quit
Else: ActiveWorkbook.Close
End If
End Sub
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
End Function
