modifier nom fichier sauvegarde en fonction valeur cellule

Version imprimable

25/12/2011, 00h38
franc83

modifier nom fichier sauvegarde en fonction valeur cellule

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

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

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