ThisworkBook

RONIBO

XLDnaute Impliqué
Bonjour le forum,

J'utilise ce que pour enregistrer mes devis ou facture.
Il permet d'automatisé le choix de l'emplacement, le nom à donner.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String
Range("F1:G1").Select
SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)
Case "D": Chemin = CheminDossierDevis
Case "F": Chemin = CheminDossierFacture
End Select
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
MyFile = Chemin & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
End With
If Dir(MyFile) <> "" Then
If MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True
MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
MsgBox "Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document"
End Sub

J'ai rajouté cette ligne

MsgBox "Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document"

Mon souhait :

Une fois que j'ai complété mon devis ou facture, je l'enregistre, demander par msgbox si je veux créer un autre document (devis ou facture).

Si oui ouvrir de nouveau le fichier modèle, sinon annulé.

Voici un fichier exemple à extraire dans c:

Merci d'avance.
 

Pièces jointes

  • Ronibo.zip
    37.6 KB · Affichages: 41
  • Ronibo.zip
    37.6 KB · Affichages: 45
  • Ronibo.zip
    37.6 KB · Affichages: 43

RONIBO

XLDnaute Impliqué
Re : ThisworkBook

Bonsoir,

J'ai trouvé ceci, mais je n'arrive pas à l'intégrer dans le msgbox yesno.

Si quelqu'un peut m´aider ca serait sympa

Dim NomXls As String, Chemin As String
NomFichier = "Modèle.xlsm"
Chemin = CheminDossierDevisFacturation & NomFichier
Set ExcelApp = CreateObject("Excel.Application")
On Error GoTo MsgError
Set ExcelCla = ExcelApp.Workbooks.Open(Chemin)
ExcelApp.Visible = True
Application.DisplayAlerts = False
Application.Quit
Exit Sub
MsgError: MsgBox "Le fichier '" & NomFichier & "' n'existe pas !" & Chr(10) & Chr(10) & "Veuillez vérifier que le fichier '" & NomFichier & "' est bien présent sur l'emplacement '" & Chemin & "' !", vbInformation, "Fichier inexistant"
 

Jack2

XLDnaute Occasionnel
Re : ThisworkBook

Bonsoir RONIBO,

Si j'ai bien compris la question du deuxième post :
Code:
Sub Teste()
Dim Rep As Integer

Rep = MsgBox("Le fichier " & NomFichier & " n'existe pas " & Chr(10) & Chr(10) & "Veuillez vérifier que le fichier " _
    & NomFichier & " est bien présent sur l'emplacement " & Chemin & " !", vbYesNo + vbInformation, "Fichier inexistant")

If Rep = vbYes Then
'......
Else
'......
End If
End Sub
A+ Jack2
 

RONIBO

XLDnaute Impliqué
Re : ThisworkBook

Bonjour,

Merci mais c'est pas tout à fait se que je voulais :(

Au faite une fois que j'ai terminé mon devis ou facture (grâce au fichier "Modèle"), je l'enregistre, j'utilise le code de mon premier post (Si tout se passe bien, normalement ma facture doit être nommée "Facture Nº001 - EXCEL DOWNLOAD (EXL)), une fois qu'il la enregistré, afficher un msgbox du genre "Voulez vous créer un autre devis ou facture ?" Avec le choix "Oui" et "Non"

Si je clic sur oui, ouvrir de nouveau le fichier Modèle
Si je clic sur non, ne rien faire (annuler l'opération)

J'espère que je me suis fais comprendre :)

Bonne journée
 

Jack2

XLDnaute Occasionnel
Re : ThisworkBook

Bonjour RONIBO,

Normalement ce bout de code devrait convenir :
Code:
MsgBox "Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document" 
Rep = MsgBox("Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document")
If Rep = vbYes Then
    Workbooks.Open "C:\Ronibo\Modèle.xlm"
    Workbooks(MyFile).Close SaveChanges:=False 
End If
End Sub
Pour la fermeture du fichier facture seuls le nom et l'extension suffisent, ce qui donnerait :
Code:
MyFileSeul = Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
MyFile = Chemin & MyFileSeul 

'.....puis
If Rep = vbYes Then
    Workbooks.Open "C:\Ronibo\Modèle.xlsm"
    Workbooks(MyFileSeul).Close SaveChanges:=False
End If
A+ Jack2
 
Dernière édition:

RONIBO

XLDnaute Impliqué
Re : ThisworkBook

Bonjour Jack,

Tout d'abord bonne fête de fin d'année :)

Tu peux regarder si j'ai bien compris svp, j'ai fais s'que tu m'as dit mais je me retrouve avec une erreur d'exécution 1004 (Fichier Modèle introuvable)

Voici le code :
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String
Range("F1:G1").Select
SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)
Case "D": Chemin = CheminDossierDevis
Case "F": Chemin = CheminDossierFacture
End Select
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
MyFileSeul = Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
MyFile = Chemin & MyFileSeul
End With
If Dir(MyFile) <> "" Then
If MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True
MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
MsgBox "Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document"
Rep = MsgBox("Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document")
If Rep = vbYes Then
Workbooks.Open "C:\Ronibo\Modèle.xlm"
Workbooks(MyFile).Close SaveChanges:=False
End If
'.....puis
If Rep = vbYes Then
Workbooks.Open "C:\Ronibo\Modèle.xlsm"
Workbooks(MyFileSeul).Close SaveChanges:=False
End If
End Sub

Tu as une idée?

Bonne journée
 

Jack2

XLDnaute Occasionnel
Re : ThisworkBook

Bonjour et bon fêtes RONIBO,

Ci-après le code qui marche :
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String, MyFileSeul As String

SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
    Select Case Left(.Range("F10"), 1)
    Case "D": Chemin = CheminDossierDevis
    Case "F": Chemin = CheminDossierFacture
    End Select
    If Dir(Chemin, vbDirectory) = "" Then
    MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
    Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
    End If
MyFileSeul = Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
MyFile = Chemin & MyFileSeul
End With

If Dir(MyFile) <> "" Then
    If MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
    MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
    Exit Sub
    End If
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True
MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"

Rep = MsgBox("Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document")
If Rep = vbYes Then
    Workbooks.Open CheminDossierDevisFacturation & "Modèle.xlsm"
    Workbooks(MyFileSeul).Close SaveChanges:=False
End If
End Sub
J'ai juste remplacé Workbooks.Open "C:\Ronibo\Modèle.xlsm" par Workbooks.Open CheminDossierDevisFacturation & "Modèle.xlsm"

A+ Jack2
 

RONIBO

XLDnaute Impliqué
Re : ThisworkBook

Bonjour,
Merci pour tes vœux :)


Je savais que j'y été presque, merci ! :)

J'aurais une dernière question concernant le msgbox suivant :

If MsgBox("Le document suivant existe déjà :" & Chr(10) & Chr(10) & """" & MyFile & """" & Chr(10) & Chr(10) & "Voulez-vous le remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"

S'qui donne :

Sans titre.png

Je voulais savoir si c'été possible de supprimer le chemin et mettre seulement le nom du fichier et même l'extension du fichier :

111.png


A+
 

Pièces jointes

  • Sans titre.png
    Sans titre.png
    7.3 KB · Affichages: 41
  • Sans titre.png
    Sans titre.png
    7.3 KB · Affichages: 41

Jack2

XLDnaute Occasionnel
Re : ThisworkBook

Bonsoir RONIBO,

Pour ne mettre que le fichier :
Remplacer & MyFile &, par & MyFileSeul &

Pour ne mettre que le fichier sans l'extension

1 s'il n'y a pas de point dans le fichier, juste entre le fichier et l'extension ( Fichier.doc):
Code:
MyFileSeul = Mid(MyFileSeul, 1, InStr(MyFileSeul, ".") - 1)
2 s'il y a un point dans le nom du fichier comme Fichier.01.doc (déclarer Dim Ext As String) :
Code:
If InStrRev(MyFileSeul, ".") Then
     Ext = Mid(MyFileSeul, InStrRev(MyFileSeul, "."))
     MyFileSeul = Left(MyFileSeul, InStr(MyFileSeul, Ext) - 1)
End If
le même en une seule ligne :
Code:
If InStrRev(MyFileSeul, ".") Then  MyFileSeul = Left(MyFileSeul, InStr(MyFileSeul, Mid(MyFileSeul,  InStrRev(MyFileSeul, "."))) - 1)
A+ Jack2
 

RONIBO

XLDnaute Impliqué
Re : ThisworkBook

Bonsoir Jack2

Merci beaucoup ! :)

Je pense que c'est bon mais tu peux quand même vérifier stp, voir si j'ai pas fait d'erreur :)

'Sauvegarde des documents (Devis & Factures)
Sub SauvegardeDocument()
Dim Chemin As String, CheminPDF As String, MyFile As String, MyFilePDF As String, MyFileSeul As String, Réponse As String
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)
Case "D"
Chemin = CheminDossierDevis
CheminPDF = CheminDossierDevisPDF
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Devis""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
If Dir(CheminPDF, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Devis (Format PDF)""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
CheminPDF = "C:\Users\" & Application.UserName & "\Desktop\"
End If
Case "F"
Chemin = CheminDossierFacture
CheminPDF = CheminDossierFacturePDF
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Facture""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
If Dir(CheminPDF, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Facture (Format PDF)""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
CheminPDF = "C:\Users\" & Application.UserName & "\Desktop\"
End If
End Select
MyFileSeul = Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
MyFile = Chemin & MyFileSeul
MyFilePDF = CheminPDF & .Range("F10") & .Range("G10").Text & " - " & .Range("A12") & " (" & .Range("F14") & ")" & ".pdf"
If InStrRev(MyFileSeul, ".") Then MyFileSeul = Left(MyFileSeul, InStr(MyFileSeul, Mid(MyFileSeul, InStrRev(MyFileSeul, "."))) - 1)
End With
If Dir(MyFile) <> "" Then
If MsgBox("Le document suivant existe déjà :" & Chr(10) & Chr(10) & MyFileSeul & Chr(10) & Chr(10) & "Voulez-vous le remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
Application.EnableEvents = False: Application.DisplayAlerts = False
ThisWorkbook.ActiveSheet.SaveAs MyFile
Application.DisplayAlerts = False: Application.EnableEvents = True
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyFilePDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
Réponse = MsgBox("Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document")
If Réponse = vbYes Then
Workbooks.Open CheminDossierDevisFacturation & "Modèle.xlsm"
Workbooks(MyFileSeul).Close SaveChanges:=False
End If
End Sub
 

Jack2

XLDnaute Occasionnel
Re : ThisworkBook

Bonjour RONIBO,
La ligne
Workbooks(MyFileSeul).Close SaveChanges:=False
MyFileSeul passe par If InStrRev(MyFileSeul, ".") et MyFileSeul devient le nom du fichier sans son extension. On ne peut pas sauvegarder un fichier sans extension. Il faudrait la rajouter en utilisant le deuxième code du post d'hier (20h33) en faisant MyFileSeul = MyFileSeul & Ext. Pour éviter ce genre d'erreur, tu définis un MyFileSansExt et tu changes le code :
Code:
If InStrRev(MyFileSeul, ".") Then  MyFileSansExt = Left(MyFileSeul, InStr(MyFileSeul, Mid(MyFileSeul,  InStrRev(MyFileSeul, "."))) - 1)
Tu as maintenant MyFileSansExt et MyFileSeul garde son extension et peut être utilisé dans la dernière ligne (sauvegarde du fichier). Change également dans la ligne suivante MyFileSeul par MyFileSansExt :
Code:
If MsgBox("Le document suivant existe déjà :" & Chr(10) & Chr(10) & MyFileSansExt & Chr(10) & Chr(10) &

J'ai parcouru ton nouveau code. Iil faut définit CheminDossierDevisPDF sinon tu auras CheminPDF ="". Enfin, Réponse n'est pas du type String, mais du type Integer pour obtenir la valeur numérique correspondant à vbYes ou à vbNo.

A+ Jack2
 

RONIBO

XLDnaute Impliqué
Re : ThisworkBook

Bonjour Jack2,

Merci pour ces explications :)

Y'a des choses que j'ai pas trop compris, ca doit être simple surement, mais avec tous ces Myfile je me suis embrouillé :s.

Voila se que j'ai compris et se que j'ai pu faire :)

Sub SauvegardeDocument()
Dim Chemin As String, CheminPDF As String, MyFile As String, MyFilePDF As String, MyFileSeul As String, MyFileSansExt As String, Réponse As Integer, Ext As String
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)
Case "D"
Chemin = CheminDossierDevis
CheminPDF = CheminDossierDevisPDF
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Devis""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
If Dir(CheminPDF, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Devis (Format PDF)""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
CheminPDF = "C:\Users\" & Application.UserName & "\Desktop\"
End If
Case "F"
Chemin = CheminDossierFacture
CheminPDF = CheminDossierFacturePDF
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Facture""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
If Dir(CheminPDF, vbDirectory) = "" Then
MsgBox "Le répertoire " & """Facture (Format PDF)""" & " n'existe pas !" & Chr(10) & Chr(10) & "Le fichier sera enregistré sur le bureau de votre ordinateur !", vbInformation, "Répertoire inexistant"
CheminPDF = "C:\Users\" & Application.UserName & "\Desktop\"
End If
End Select

MyFileSansExt = Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
MyFile = Chemin & MyFileSeul
MyFileSeul = MyFileSeul & Ext
MyFilePDF = CheminPDF & .Range("F10") & .Range("G10").Text & " - " & .Range("A12") & " (" & .Range("F14") & ")" & ".pdf"

If InStrRev(MyFileSeul, ".") Then MyFileSansExt = Left(MyFileSeul, InStr(MyFileSeul, Mid(MyFileSeul, InStrRev(MyFileSeul, "."))) - 1)
End With
If Dir(MyFile) <> "" Then
If MsgBox("Le document suivant existe déjà :" & Chr(10) & Chr(10) & MyFileSansExt & Chr(10) & Chr(10) & "Voulez-vous le remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
Application.EnableEvents = False: Application.DisplayAlerts = False
ThisWorkbook.ActiveSheet.SaveAs MyFile
Application.DisplayAlerts = False: Application.EnableEvents = True
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyFilePDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
Réponse = MsgBox("Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document")
If Réponse = vbYes Then
Workbooks.Open CheminDossierDevisFacturation & "Modèle.xlsm"
Workbooks(MyFileSeul).Close SaveChanges:=False
End If
End Sub

Quand tu dis "il faut définir CheminDossierDevisPDF"
C'est pas ca?
Public Const CheminDossierDevisPDF As String = "C:\Users\Admin\SkyDrive\Société\Métal France\Devis & Facturation\Devis\Devis (Format PDF)\"

A+
 

Discussions similaires

Réponses
2
Affichages
286

Statistiques des forums

Discussions
312 765
Messages
2 091 873
Membres
105 084
dernier inscrit
lca.pertus