[XL-2007] modifier nom fichier sauvegarde en fonction valeur cellule [Résolu]

[franc83]

Bonjour
voila mon problème
je sauvegarde ma feuille avec ce code
Dans ma clef USB et le fichier "Noms pour Table.xlsx"

Code :

Workbooks.Open Drv.driveletter & ":\Noms pour Table.xlsx"

mais je voudrais ajouter après "Table" la valeur de la cellule L7 de la feuille Accueil
ce qui donnerait si [L7]=1" Noms pour Table1.xlsx
je voudrais donc incorporer ce code

Code :

Sheets("Accueil").Range("L7").Value

mais je sèche
merci

[kiki29]

Salut, tu parles de Sauvegarde mais ton code est pour l'ouverture, bref qqch comme

Code :

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Sub Tst()
Dim str As String
 
    str = Sheets("Accueil").Range("L7").Value
    ChDir "H:\"
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:="Noms pour Table" & str & ".xlsb", FileFormat:=xlExcel12
    Application.DisplayAlerts = True
End Sub

Voir également http://silkyroad.developpez.com/Exce...cel2007/#LII-A car tu dois utiliser un format conservant les macros ce qui n'est pas le cas du format XLSX

A rajouter, une routine pour vérifier que L7 contient qqch de valide

[franc83]

Bonjour KIKI29
merci d'avoir répondu si vite ,j'étais resté dans mon idée et j'ai oublié de passer par une variable.
je te donne mon code modifié , il recherche la lettre du lecteur amovible avant d'enregistrer.

Code :

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
Sub Copier_Feuille_dans_USB_Clic()
    Dim FSO As Object
    Dim Drv As Object
    Dim str As String
 
    'Correspond au nom de la  clef.
    Const Cible As String = "Ma clef"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    str = Sheets("Accueil").Range("L7").Value
    On Error Resume Next
    For Each Drv In FSO.Drives
        If Drv.DriveType = 1 Then
         If Drv.driveletter <> "A" Then
            If Drv.VolumeName = UCase(Cible) And Drv.IsReady Then
            Sheets(Array("Feuille1", "Feuille2")).Copy
                ActiveWorkbook.SaveAs Drv.driveletter & ":\Resultats Table" & str & " .xlsx"
                ActiveWorkbook.Close savechanges:=False
                Exit Sub
            End If
           End If
        End If
    Next
 
    MsgBox "Enregistrement non effectué." & vbCrLf & _
        "Le lecteur amovible '" & Cible & "' n'a pas été trouvé."
End Sub

merci