Microsoft 365 Code VBA - Erreur

K

Keiko

XLDnaute Occasionnel
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><p> United Focus SPRL<br/> Rue de Hermée 245<br/> 4040 Herstal<br/> BE0696.839.882<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 Focus 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

Merci et très bonne soirée à tout le monde !
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

Cédric06400
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
371
Franc58
F
R3n0W
  • Résolu(e)
XL 2016 If Not xRgSel Is Nothing Then --> Ne marche pas
Réponses
10
Affichages
402
R3n0W
R3n0W
F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
1 K
Fabrice16ct
F
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
714
jebibo
J
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
316
Gégé-45550
Gégé-45550
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
360
Chaton77
Chaton77
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
320
rebatte
R
K
  • Résolu(e)
XL 2019 Probleme codage
Réponses
2
Affichages
355
Kevin42560
K
M
  • Résolu(e)
XL 2019 Excel - générer .PDF avec envoie mail
Réponses
12
Affichages
2 K
Mika07
M
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
337
sebastien176
S

Membres actuellement en ligne

16 membres et 221 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 698
Messages
2 112 016
Membres
111 396
dernier inscrit
Baax