Macro

Le 29/03/2016 à 12:13

Bonjour à tous, je sollicite votre aide

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

Le 29/03/2016 à 12:31

Bonjour,

comme l'indique le message d'erreur, tu n'as pas défini la variable "mail".

Remplace outlookmail par mail dans l'instruction dim outlookmail dans ton code.

Le 29/03/2016 à 13:04

Merci pour ton aide mais du coup j'ai un autre message d'erreur (erreur de compilation, variable non définie)

sur le texte en rouge

Private Sub EnvoisMail()

Dim OutlookApp As Object

Dim Mail 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

Le 29/03/2016 à 13:23

bonjour,

ajoute une instruction

dim curfile

à la suite des autres instructions dim

Le 29/03/2016 à 13:47

nickel un grand merci à toi ça marche super

Rechercher des sujets similaires à "macro"