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
390
Franc58
F
A
  • Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
280
sylvanu
sylvanu
R3n0W
  • Résolu(e)
XL 2016 If Not xRgSel Is Nothing Then --> Ne marche pas
Réponses
10
Affichages
418
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
F
  • Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
302
Oneida
Oneida
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
Phil69970
ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
424
ph.vanne
ph.vanne
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
747
jebibo
J
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
157
sebastien176
S
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
349
Gégé-45550
Gégé-45550

Membres actuellement en ligne

2 membres et 25 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
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi