Sub offre1petitepuissance()
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 1 - <10 KVA ?", vbYesNo) = vbNo Then Exit Sub
Sheets([B7].Text).Activate.Unprotect Password:="Jpc42*"
Sheets("1-O<10").Select
Columns("a:fl").Select
Selection.ColumnWidth = 2.7
Selection.RowHeight = 7
Sheets("B7").Activate.Protect Password:="Jpc42*"
Sheets("l").Select
Logiciel = Range("h7")
contrat = Range("A1")
Nom = Range("D17")
PRENOM = Range("D18")
PANNEAU = Range("A6")
ONDULEUR = Range("A7")
nombre = Range("A4")
Tel = Range("g15")
lieu = Range("g14")
JOUR = Format(Day(Now()), "00") & Format(Month(Now()), "00") & Year(Now)
SauvegardeIndicateurs = "C:\PPV\United Focus\PPV - Documents\" & Range("F7") & "\" & 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 & contrat & "-" & JOUR & "-" & Format(Time, "hhmmss") & " - " & Nom & " - " & PRENOM & " - " & lieu & " - " & Tel & " - " & nombre
Sheets("1-O<10").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SauvegardeIndicateurs & nomfichier1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
ignorePrintAreas:=True, OpenAfterPublish:=True
Application.Workbooks(1).SaveCopyAs SauvegardeIndicateurs & nomfichier1 & ".xlsm"
'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("G16")
.CC = "
jonathan.dethier@united"
.Subject = "United Focus - Devis"
.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 & 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)
nomfichier1 = Logiciel & " - " & Nom & " - " & PRENOM & " - " & lieu & " - " & Tel
Sheets(Array("DP", "CABLE", "ORES")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SauvegardeIndicateurs & nomfichier1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
ignorePrintAreas:=True, OpenAfterPublish:=False
Sheets(Array("20% PV")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SauvegardeIndicateurs & Range("D11") & " - " & Range("d12") & " - " & Range("D13") & " - " & Range("D14") & " - " & Range("D15") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
ignorePrintAreas:=True, OpenAfterPublish:=False
Application.ScreenUpdating = False
Sheets("l").Select
End Sub
Voici le code et en rouge ceux qui doivent reprendre la bonne feuille B7