Discussion :

[Akhlan]

Hello,

J'ai avancé sur mon projet grâce à BlueMonkey mais je suis confronté à un autre soucis... Je veux sauvegarder le fichier sous un répertoire Réseau auquel j'ai bien sur accès mais même si le code ci dessous ne me retopurne pas d'erreur, l'enregistrement pointe tout le temps sur le répertoire d'ouverture du fichier...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Declare Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
Public Function ChDirNet(szPath As String) As Boolean
    Dim lReturn As Long
    lReturn = SetCurrentDirectoryA(szPath)
    ChDirNet = CBool(lReturn <> 0)
End Function
Function GetDateFormatUS(d As Date) As String
    GetDateFormatUS = Evaluate("TEXT(" & CLng(d) & ",""dd-mmm-yyyy"")")
End Function
 
Sub Save_Print()
 
Dim Customer, today, FName As String
Dim CT As String * 6
Dim Tri As String * 3
Dim nbColis As Integer
 
today = GetDateFormatUS(Now()) 'Date au Format US
Customer = Worksheets("DO_FR").Range("E10") 'Récupère nom du Projet
CT = Right(Worksheets("Shipping").Range("C7"), 6) 'Récupère la fin du N° de requête
Tri = WorksheetFunction.VLookup(Range("E47").Value, Worksheets("Contacts").Range("C2:J8"), 8, False) 'Récupère le Trigramme
FName = ("Delivery Order " & Customer & " (" & CT & ") " & StrConv(today, vbUpperCase) & Chr(160) & Tri) 'Concatène les infos pour avoir le nom de fichier
nbColis = WorksheetFunction.Sum(Range("E20:E38")) 'Prépare le nombre d'impression n+2
 
ChDirNet "\\RNS01\Dept\Cso\itso\COS\Facilities\Security Activity\Expedition"
'ChDirNet "H:\Facilities\Security Activity\Expedition"
 
Application.Dialogs(xlDialogSaveAs).Show (FName & ".xlsm") 'Enregistre avec nom préformaté
 
'ActiveWindow.SelectedSheets.PrintOut Copies:=nbColis + 2, Collate:=True, IgnorePrintAreas:=False 'Imprime n+2 fois
 
FNameFull = "'" & FName & ".xlsm" & "'"
 
MsgBox (FNameFull & " a été enregistré et imprimé " & nbColis + 2 & " fois")
 
End Sub

J'ai essayé ces deux commandes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ChDirNet "\\RNS01\Dept\Cso\itso\COS\Facilities\Security Activity\Expedition"
'ChDirNet "H:\Facilities\Security Activity\Expedition"

mais sans succès....

Je veux que la fenêtre d'enregistrement s'ouvre sur "H:\Facilities\Security Activity\Expedition" comment faire ???

D'avance merci
Akhlan

[jackborogar]

Bonjour,

Que penses tu de cela?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Function CreationDossier(sDossier) As Long 'Fonction pour créer Dossier de Sauvergarde
 
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Sauvegarde()
 
    On Error GoTo CreerDossier 'Si il y a une erreur alors directement à la ligne CreerDossier
 
    Dim sDossier As String
   today = GetDateFormatUS(Now()) 'Date au Format US
   Customer = Worksheets("DO_FR").Range("E10") 'Récupère nom du Projet
   CT = Right(Worksheets("Shipping").Range("C7"), 6) 'Récupère la fin du N° de requête
 
Tri = WorksheetFunction.VLookup(Range("E47").Value, Worksheets("Contacts").Range("C2:J8"), 8, False) 'Récupère le Trigramme
FName = ("Delivery Order " & Customer & " (" & CT & ") " & StrConv(today, vbUpperCase) & Chr(160) & Tri) 'Concatène les infos pour avoir le nom de fichier 
    sDossier = "H:\Facilities\Security Activity\Expedition\"    
Fichier = FName 
 
CreerDossier:
 
    If Err.Number = 1004 Then 'Si dossier pas créer
 
        CreationDossier sDossier 'On le créer en appelant la fct "CreationDossier"
 
    End If
 
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs sDossier & "\" & Fichier & ".xlsm" 'Sauvergarde du dossier
    Application.DisplayAlerts = True
    MsgBox ("Votre fichier a bien été enregistré") 'Fenêtre d'information
 
    Exit Sub
 
End Sub

Tu l'adaptes ensuite à ton code! J'ai pas eu le temps de le faire!

Cdt,

[Akhlan]

j'ai mal expliqué jackborogar ;-)

je veux faire pointer la fenêtre d'enregistrement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Dialogs(xlDialogSaveAs).Show (FName & ".xlsm")

à ce niveau "H:\Facilities\Security Activity\Expedition" de l'arborescence mais en dessous, j'ai d'autre répertoires qui sont eux aussi divisés en sous répertoire et ainsi de suite... Ça sera à l'utilisateur de choisir le répertoire final (répertoire qui existe déjà)

PS : Par contre merci pour la fonction "Application.DisplayAlerts", je cherchais un moyen de vérifier que la copie avait bien eu lieu....

[jackborogar]

Tu viens de l'ecrire ton code ?!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
FName = "H:\Facilities\Security Activity\Expedition\"
 
Application.Dialogs(xlDialogSaveAs).Show (FName & "TON NOM DE FICHIER.xlsm")

Ici ça ouvre à ton chemin H:\Facilities\Security Activity\Expedition et sa donne "NOM DE FICHIER" en nom...

[Akhlan]

non malheureusement ça ne fonctionne pas...

je pointe toujours sur mon répertoire local et non pas sur le disque réseau "H"...

RepUse = "H:\Facilities\Security Activity\Expedition"

Application.Dialogs(xlDialogSaveAs).Show (RepUse & FName & ".xlsm") 'Enregistre avec nom préformaté

J'ai essayé de mapper le lecteur H via cette commande

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim oNet
Set oNet = CreateObject("Wscript.Network")
oNet.MapNetworkDrive "H:", "\\RNS01\Dept\Cso\itso\COS"
WSCript.Quit

Mais ça m'indique que c'est déjà effectif...

[jackborogar]

Ecoute je viens de tester sur le disque réseau de ma boite et ça fonctionne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
 
FName = "M:\Administration\"
 
Application.Dialogs(xlDialogSaveAs).Show (FName & "TON NOM DE FICHIER.xlsm")
 
End Sub

Ma fenêtre enregistrer sous s'ouvre dans mon répertoire jusqu'à Administration et donne le "TON NOM DE FICHIER" en nom ...

N'oublie pas le "\" à la fin de ton chemin dans FName