[vba] cmt forcer excel a enregistrer a l'emplacement c:\windows\test ?

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [vba] cmt forcer excel a enregistrer a l'emplacement c:\windows\test ?

fredrider

Bonjour a tous!
voila en fait j'aimerai savoir comment faire pour forcer excel a sauvegarder un classeur a un emplacement prédéfini comme par exemple c:\windows\test

?
merci d'avance

Publicité

fredrider

sans passer par fichier -> enregistrer sous
car en fait je veux obliger l'utilisateur a enregistrer son travail a un emplacement bien precis (en l'occurence sur un reseau)
help...

fredrider

j'utilise deja ce code qui m'ouvre une fenetre... une sorte d'explorer quoi et ou je valide le dossier ou je souhaite mettre mon fichier mais je veux desactiver la possibilité d'utiliser "fichier enregistrer sous"

Code :

Dim Dossier_choisi As String
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Sub Parcourir()
Dim Rien As Integer
Dim Liste As Long
Dim Resultat As String
Dim Browse_info As BrowseInfo
With Browse_info
' .hWndOwner = Me.hWnd
.lpszTitle = lstrcat("Choix du dossier à analyser", "" )
.ulFlags = 1
End With
Liste = SHBrowseForFolder(Browse_info)
If Liste Then
Resultat = String$(260, 0)
SHGetPathFromIDList Liste, Resultat
CoTaskMemFree Liste
Rien = InStr(Resultat, vbNullChar)
If Rien Then
Dossier_choisi = Left$(Resultat, Rien - 1)
MsgBox "Le dossier choisi est :" & vbNewLine & Dossier_choisi, vbInformation
ActiveWorkbook.SaveAs Filename:=Dossier_choisi & "\" & "suivi_de_l_activite"
End If
End If
End Sub
Private Sub ecrire(A_ecrire As String, Optional Gras As Boolean, Optional Couleur As Long)
Etat.SelStart = Len(Etat)
Etat.SelBold = Gras
If Not (IsMissing(Couleur)) Then
Etat.SelColor = Couleur
Else
Etat.SelColor = vbBlack
End If
Etat.SelText = A_ecrire & vbNewLine
Etat.SelBold = False
Etat.SelColor = vbBlack
End Sub
Public Function explorer(ByVal Chemin As String)
On Error Resume Next
Dim id_1 As Integer
Dim id_2 As Integer
Dim id_3 As Integer
Dim ids() As String
Dim dossier_courant As String
If Dir(Chemin, vbDirectory) = "" Then
Exit Function
End If
dossier_courant = Dir(Chemin, vbDirectory)
Do While dossier_courant <> ""
If dossier_courant <> "." And dossier_courant <> ".." Then
If (GetAttr(Chemin & dossier_courant) And vbDirectory) <> 0 Then
id_1 = id_1 + 1
End If
End If
dossier_courant = Dir
Loop
ReDim ids(id_1)
dossier_courant = Dir(Chemin, vbDirectory)
Do While dossier_courant <> ""
If dossier_courant <> "." And dossier_courant <> ".." Then
If (GetAttr(Chemin & dossier_courant) And vbDirectory) <> 0 Then
id_2 = id_2 + 1
ids(id_2) = dossier_courant
If Afficher_sous_dossiers.Value <> 0 Then
ecrire dossier_courant, True
End If
Else
ecrire dossier_courant
End If
End If
dossier_courant = Dir
Loop
For id_3 = 1 To id_1
If Sous_dossiers.Value <> 0 Then
explorer Chemin & ids(id_3) & "\"
End If
Next
End Function
Private Sub Parti_Click()
If Dossier_choisi = "" Then
MsgBox "Vous devez sélectionner un dossier à analyser.", vbExclamation
Exit Sub
End If
If Right(Dossier_choisi, 1) <> "\" Then
Dossier_choisi = Dossier_choisi & "\"
End If
Parcourir.Enabled = False
Sous_dossiers.Enabled = False
Afficher_sous_dossiers.Enabled = False
Parti.Enabled = False
Etat.Text = ""
ecrire "C'est parti dans " & Dossier_choisi, True, vbBlue
explorer Dossier_choisi
ecrire "C'est fini !", True, vbBlue
Parcourir.Enabled = True
Sous_dossiers.Enabled = True
Afficher_sous_dossiers.Enabled = True
Parti.Enabled = True
End Sub

AlainTech

Pas trouvé? Cherche encore!

Le problème va être de savoir comment est libellée la ligne "Enregistrer sous..."
Ce sera différent en fonction de la langue de l'utilisateur.

Si le menu Fichier est dans sa disposition d'origine (Excel 2000), "Enregistrer sous..." est en 5e position.

On peut donc appliquer le code suivant pour supprimer cette option:

Application.CommandBars("File" ).Controls(5).Delete

Pour remettre l'option dans le menu (ne pas oublier!), la commande est moins ambiguë:

Application.CommandBars("File" ).Controls.Add Type:=msoControlButton, ID:= _
748, Before:=5

Message édité par AlainTech le 29-05-2005 à 14:53:49

---------------
Si on vous donne une info qui marche, DITES-LE!!!! ------ Si vous trouvez seul, AUSSI, votre solution peut servir à d'autres! ------ Je dois la majorité de mes connaissances à mes erreurs!

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[vba] cmt forcer excel a enregistrer a l'emplacement c:\windows\test ?

Sujets relatifs
problème vba excel avec les dates	[Excel VBA] protéger des cellule en maintenant l'accès au plan
formule stat excel en delphi	Excel via POI, et fichiers avec macros...
Récuperer le nom d'une feuille excel	Programme VB sous EXCEL
[VBA Excel macro]réutilisation de variable + comparaisons auto	Macro word exporter vers excel
menu déroulant vba => excel	c++ et excel
Plus de sujets relatifs à : [vba] cmt forcer excel a enregistrer a l'emplacement c:\windows\test ?

Page générée en 0.053 secondes