Bonjour DC,
Essaie ceci :
Tu dois renseigner la variable Chemin dans la procédure.
'--------------------------------
Sub EnregistrerSous()
Dim Chemin As String
Dim Fichier As String
Dim LeString As Variant
LeString = Array("*", "?", ":", "/", "", "[", "]")
Chemin = "c:ATravail" 'A renseigner
Fichier = Application.InputBox _
("Insérérer le nom du fichier.", "Nom du fichier")
'Où est ledit répertoire
If Fichier = "Faux" Then
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
For Each elt In LeString
If InStr(1, Fichier, elt, vbTextCompare) <> 0 Then
If MsgBox("interdiction d'utiliser ces symboles : " & _
vbCrLf & vbCrLf & _
"""*"", ""?"", "":"", ""/"", """", ""["", ""]""" & _
vbCrLf & vbCrLf & "dans le nom d'un fichier." & _
vbCrLf & vbCrLf & "Désirez-vous continuer ?", _
vbCritical + vbYesNo) = vbYes Then
EnregistrerSous
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
Next
If Right(Fichier, 4) <> ".XLS" Then
Fichier = Fichier & ".xls"
End If
Chemin = ChoixDossier(Chemin)
If Chemin <> "" Then
If MsgBox("Votre fichier sera enregistrer là : " & _
vbCrLf & vbCrLf & Chemin & "" & Fichier & vbCrLf & vbCrLf & _
"Désirez-vous continuez?", _
vbYesNo + vbInformation, "Enregistrer sous") = vbYes Then
ThisWorkbook.SaveAs Chemin & "" & Fichier
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
End Sub
'----------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
If objFolder Is Nothing Then
ChoixDossier = ""
Else
ChoixDossier =
objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
End If
End Function
'----------------------------------
Salutations!
"DC" a écrit dans le message de news:
437a1baa$0$18332$
Bonsoir à tous,..................et bonne soirée...!!
Merci d'avance...!!
Serait-il possible avec une macro, de sauvegarder un classeur nommé "
Facture ", dans un Dossier " Daniel tous ensembles " et dans lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA, pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,
Salutations!............encore Merci...!!...................DC
Bonjour DC,
Essaie ceci :
Tu dois renseigner la variable Chemin dans la procédure.
'--------------------------------
Sub EnregistrerSous()
Dim Chemin As String
Dim Fichier As String
Dim LeString As Variant
LeString = Array("*", "?", ":", "/", "", "[", "]")
Chemin = "c:ATravail" 'A renseigner
Fichier = Application.InputBox _
("Insérérer le nom du fichier.", "Nom du fichier")
'Où est ledit répertoire
If Fichier = "Faux" Then
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
For Each elt In LeString
If InStr(1, Fichier, elt, vbTextCompare) <> 0 Then
If MsgBox("interdiction d'utiliser ces symboles : " & _
vbCrLf & vbCrLf & _
"""*"", ""?"", "":"", ""/"", """", ""["", ""]""" & _
vbCrLf & vbCrLf & "dans le nom d'un fichier." & _
vbCrLf & vbCrLf & "Désirez-vous continuer ?", _
vbCritical + vbYesNo) = vbYes Then
EnregistrerSous
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
Next
If Right(Fichier, 4) <> ".XLS" Then
Fichier = Fichier & ".xls"
End If
Chemin = ChoixDossier(Chemin)
If Chemin <> "" Then
If MsgBox("Votre fichier sera enregistrer là : " & _
vbCrLf & vbCrLf & Chemin & "" & Fichier & vbCrLf & vbCrLf & _
"Désirez-vous continuez?", _
vbYesNo + vbInformation, "Enregistrer sous") = vbYes Then
ThisWorkbook.SaveAs Chemin & "" & Fichier
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
End Sub
'----------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
If objFolder Is Nothing Then
ChoixDossier = ""
Else
ChoixDossier =
objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
End If
End Function
'----------------------------------
Salutations!
"DC" <da.campion@hotmail.fr> a écrit dans le message de news:
437a1baa$0$18332$8fcfb975@news.wanadoo.fr...
Bonsoir à tous,..................et bonne soirée...!!
Merci d'avance...!!
Serait-il possible avec une macro, de sauvegarder un classeur nommé "
Facture ", dans un Dossier " Daniel tous ensembles " et dans lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA, pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,
Salutations!............encore Merci...!!...................DC
Bonjour DC,
Essaie ceci :
Tu dois renseigner la variable Chemin dans la procédure.
'--------------------------------
Sub EnregistrerSous()
Dim Chemin As String
Dim Fichier As String
Dim LeString As Variant
LeString = Array("*", "?", ":", "/", "", "[", "]")
Chemin = "c:ATravail" 'A renseigner
Fichier = Application.InputBox _
("Insérérer le nom du fichier.", "Nom du fichier")
'Où est ledit répertoire
If Fichier = "Faux" Then
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
For Each elt In LeString
If InStr(1, Fichier, elt, vbTextCompare) <> 0 Then
If MsgBox("interdiction d'utiliser ces symboles : " & _
vbCrLf & vbCrLf & _
"""*"", ""?"", "":"", ""/"", """", ""["", ""]""" & _
vbCrLf & vbCrLf & "dans le nom d'un fichier." & _
vbCrLf & vbCrLf & "Désirez-vous continuer ?", _
vbCritical + vbYesNo) = vbYes Then
EnregistrerSous
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
Next
If Right(Fichier, 4) <> ".XLS" Then
Fichier = Fichier & ".xls"
End If
Chemin = ChoixDossier(Chemin)
If Chemin <> "" Then
If MsgBox("Votre fichier sera enregistrer là : " & _
vbCrLf & vbCrLf & Chemin & "" & Fichier & vbCrLf & vbCrLf & _
"Désirez-vous continuez?", _
vbYesNo + vbInformation, "Enregistrer sous") = vbYes Then
ThisWorkbook.SaveAs Chemin & "" & Fichier
Else
MsgBox "opération annulée.", vbInformation, "Enregistrement"
Exit Sub
End If
End If
End Sub
'----------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
If objFolder Is Nothing Then
ChoixDossier = ""
Else
ChoixDossier =
objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
End If
End Function
'----------------------------------
Salutations!
"DC" a écrit dans le message de news:
437a1baa$0$18332$
Bonsoir à tous,..................et bonne soirée...!!
Merci d'avance...!!
Serait-il possible avec une macro, de sauvegarder un classeur nommé "
Facture ", dans un Dossier " Daniel tous ensembles " et dans lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA, pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,
Salutations!............encore Merci...!!...................DC
Bonsoir à tous,..................et bonne soirée...!!Bonjour,
Merci d'avance...!!
Serait-il possible avec une macro, de sauvegarder un classeur nommé
"
Facture ", dans un Dossier " Daniel tous ensembles " et dans
lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA,
pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,
Salutations!............encore Merci...!!...................DC
Bonsoir à tous,..................et bonne soirée...!!Bonjour,
Merci d'avance...!!
Serait-il possible avec une macro, de sauvegarder un classeur nommé
"
Facture ", dans un Dossier " Daniel tous ensembles " et dans
lequel se
trouve 4 sous-dossiers " 1+2+3+4 " et avec une fenêtre VBA,
pour avoir le
choix du sous-dossier, avant le OK de sauvegarde,
Salutations!............encore Merci...!!...................DC