Microsoft 365 Code VBA - Erreur

Keiko · 23 Février 2021

Bonjour,

voici mon code ci-dessous.
Il a toujours fonctionné mais depuis aujourd'hui en faisant quelques modifications surtout sur le nom des fichiers et page, je n'ai pas changé le code.
J'ai bien vérifié pour les pages, tout est juste.

Qu'en pensez-vous?

Et si vous avez des idées pour l'améliorer ou simplifié, je prends 🙂

If Range("d96") = "" Then Exit Sub
If Range("d97") = "" Then Exit Sub
If Range("d98") = "" Then Exit Sub
If Range("d99") = "" Then Exit Sub

If MsgBox("Voulez vous exécuter la macro OFFRE PV ?", vbYesNo) = vbNo Then Exit Sub

Sheets([h1].Text).Select
ActiveSheet.Unprotect Password:="Jpc42*"
ActiveSheet.Columns("a:fl").Select
Selection.ColumnWidth = 2.7
Selection.RowHeight = 7
ActiveSheet.Protect Password:="Jpc42*"

Sheets("l").Select

LOGICIEL = Range("A30")
Nom = Range("A31")
PRENOM = Range("A32")
PANNEAU = Range("A33")
TEL = Range("A34")
NOMBRE = Range("A35")
LIEU = Range("A36")
NBR1 = Range("A37")

SauvegardeIndicateurs = "C:\PPV\United Focus\PPV - Documents\" & Range("G7") & "\" & Range("'L'!D10") & "\" & Range("D17") & "-" & Range("D18") & "-" & Range("g14") & "-" & Range("g15") & "\"

On Error Resume Next
fichierexistant = GetAttr(fichier) And vbDirectory
If fichierexistant = False Then
MkDir (SauvegardeIndicateurs)
End If

nomfichier1 = LOGICIEL & "-" & Nom & "-" & PRENOM & "-" & PANNEAU & "-" & TEL & "-" & NOMBRE & "-" & LIEU & "-" & NBR1

Sheets([h1].Text).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SauvegardeIndicateurs & "PV" & "-" & nomfichier1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
ignorePrintAreas:=True, OpenAfterPublish:=True

Application.Workbooks(1).SaveCopyAs SauvegardeIndicateurs & "EXCEL" & "-" & nomfichier1 & ".xlsm"

Application.ScreenUpdating = False

'Fonctionne sous excel 2000-2013
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = Range("'L'!A13")
.CC = "jodethier@genial.be"
.Subject = "United Focus - Devis PV"
.HTMLBody = " " & _
"<html><body> United Focus SPRL Rue de Hermée 245 4040 Herstal BE0696.839.882 " & _
Range("'L'!D17") & " " & Range("'L'!D18") & ", Comme convenu lors de notre entrevue, je vous prie de trouver ci-joint notre proposition commerciale concernant le placement de panneaux " & _
"photovoltaïque. United Focus a la particularité de vous proposer 6 propositions en 1. Nous avons pendant l'entrevue déterminé ensemble la " & _
"proposition qui répond le plus à vos attentes : - Panneau : " & Range("'L'!A5") & " " & Range("'L'!A6") & " " & _
"- Onduleur : " & Range("'L'!A7") & " - Une puissance installée de " & Range("'L'!A11") & "WC - Une production " & _
"estimée de " & Range("'L'!A9") & "KW/H Pour un coût total TVAC de " & Range("'L'!A10") & " Par ailleurs sachez qu' il est tout à fait possible d'adapter le devis si besoin " & _
"à une autre des 6 solutions. Nous attirons votre attention sur le fait que cette proposition commerciale est valable jusqu'au " & Range(" '1-O<10'!bP15") & "." & " Bien évidemment, " & _
"votre conseiller " & Range("'L'!D10") & " reste à votre disposition pour toutes informations complémentaires. Pour valider l'offre choisie, merci de nous renvoyer " & _
"la page 3 datée et signée, avec la mention 'lu et approuvé'. Veuillez agréer, " & Range("'L'!D17") & " " & Range("'L'!D18") & ", nos sincères salutations. " & _
"Votre conseiller : " & Range("'L'!D10") & " - " & Range("'L'!G10") & " </body></html>"
.Attachments.Add SauvegardeIndicateurs & "PV" & "-" & nomfichier1 & ".pdf"
.Display
End With

Application.ScreenUpdating = False

LOGICIEL = Range("C1")
CONTRAT = Range("E1")
Nom = Range("d17")
PRENOM = Range("d18")
TEL = Range("g15")
LIEU = Range("g14")
JOUR = Format(Day(Now()), "00") & Format(Month(Now()), "00") & Year(Now)

Sheets(Array("IP", "C", "O")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SauvegardeIndicateurs & "POSE" & "-" & Range("l2") & "-" & Range("l3") & "-" & Range("m2") & "-" & Range("M3") & "-" & Range("M4") & "-" & Range("M5") & "-" & Range("M6") & "-" & Range("M7") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
ignorePrintAreas:=True, OpenAfterPublish:=False

Application.ScreenUpdating = False

Sheets("l").Select

Merci et très bonne soirée à tout le monde !

Staple1600 · 23 Février 2021

Bonsoir le fil

[Juste pour infos]
En général, on évite de publier une adresse mail réelle sur un forum public.
(sauf si on adore le spam)

Et petite suggestion en passant, le code VBA c'est plus facile à lire ainsi, non ?

VB:

Sub MaMacro()
If Range("d96") = "" Then Exit Sub
If Range("d97") = "" Then Exit Sub
If Range("d98") = "" Then Exit Sub
If Range("d99") = "" Then Exit Sub

If MsgBox("Voulez vous exécuter la macro OFFRE PV ?", vbYesNo) = vbNo Then Exit Sub

Sheets([h1].Text).Select
ActiveSheet.Unprotect Password:="Jpc42*"
ActiveSheet.Columns("a:fl").Select
Selection.ColumnWidth = 2.7
Selection.RowHeight = 7
ActiveSheet.Protect Password:="Jpc42*"

Sheets("l").Select

LOGICIEL = Range("A30")
Nom = Range("A31")
PRENOM = Range("A32")
PANNEAU = Range("A33")
TEL = Range("A34")
NOMBRE = Range("A35")
LIEU = Range("A36")
NBR1 = Range("A37")

SauvegardeIndicateurs = "C:\Users\Documents\" & Range("G7") & "\" & Range("'L'!D10") & "\" & Range("D17") & "-" & Range("D18") & "-" & Range("g14") & "-" & Range("g15") & "\"

On Error Resume Next
fichierexistant = GetAttr(fichier) And vbDirectory
If fichierexistant = False Then
MkDir (SauvegardeIndicateurs)
End If

nomfichier1 = LOGICIEL & "-" & Nom & "-" & PRENOM & "-" & PANNEAU & "-" & TEL & "-" & NOMBRE & "-" & LIEU & "-" & NBR1

Sheets([h1].Text).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SauvegardeIndicateurs & "PV" & "-" & nomfichier1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
ignorePrintAreas:=True, OpenAfterPublish:=True

Application.Workbooks(1).SaveCopyAs SauvegardeIndicateurs & "EXCEL" & "-" & nomfichier1 & ".xlsm"

Application.ScreenUpdating = False

'Fonctionne sous excel 2000-2013
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = Range("'L'!A13")
.CC = "prenomnom@domain.be"
.Subject = "Devis"
.HTMLBody = " " & _
"<html><body><p> United United ABCD<br/> Rue de Rue 245<br/> 1234 VILLE<br/> BE0600.123.122<br/><br/><br/> " & _
Range("'L'!D17") & " " & Range("'L'!D18") & ",<br/><br/> Comme convenu lors de notre entrevue, je vous prie de trouver ci-joint notre proposition commerciale concernant le placement de panneaux " & _
"photovoltaïque.<br/> United United a la particularité de vous proposer 6 propositions en 1.<br/> Nous avons pendant l'entrevue déterminé ensemble la " & _
"proposition qui répond le plus à vos attentes :<br/><br/> - Panneau : " & Range("'L'!A5") & " " & Range("'L'!A6") & "<br/> " & _
"- Onduleur : " & Range("'L'!A7") & "<br/> - Une puissance installée de " & Range("'L'!A11") & "WC<br/> - Une production " & _
"estimée de " & Range("'L'!A9") & "KW/H<br/><br/> Pour un coût total TVAC de " & Range("'L'!A10") & "<br/><br/> Par ailleurs sachez qu' il est tout à fait possible d'adapter le devis si besoin " & _
"à une autre des 6 solutions.<br/><br/> Nous attirons votre attention sur le fait que cette proposition commerciale est valable jusqu'au " & Range(" '1-O<10'!bP15") & "." & "<br/> Bien évidemment, " & _
"votre conseiller " & Range("'L'!D10") & " reste à votre disposition pour toutes informations complémentaires.<br/><br/> Pour valider l'offre choisie, merci de nous renvoyer " & _
"la page 3 datée et signée, avec la mention 'lu et approuvé'.<br/><br/><br/> Veuillez agréer, " & Range("'L'!D17") & " " & Range("'L'!D18") & ", nos sincères salutations.<br/><br/><br/> " & _
"Votre conseiller : " & Range("'L'!D10") & " - " & Range("'L'!G10") & " </p></body></html>"
.Attachments.Add SauvegardeIndicateurs & "PV" & "-" & nomfichier1 & ".pdf"
.Display
End With

Application.ScreenUpdating = False

LOGICIEL = Range("C1")
CONTRAT = Range("E1")
Nom = Range("d17")
PRENOM = Range("d18")
TEL = Range("g15")
LIEU = Range("g14")
JOUR = Format(Day(Now()), "00") & Format(Month(Now()), "00") & Year(Now)

Sheets(Array("IP", "C", "O")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SauvegardeIndicateurs & "POSE" & "-" & Range("l2") & "-" & Range("l3") & "-" & Range("m2") & "-" & Range("M3") & "-" & Range("M4") & "-" & Range("M5") & "-" & Range("M6") & "-" & Range("M7") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
ignorePrintAreas:=True, OpenAfterPublish:=False

Application.ScreenUpdating = False

Sheets("l").Select
End Sub

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Code VBA - Erreur

Keiko

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée