Macro pour Sauvergarde du classe sur Clé ou autre support

[Lisa]

Bonjour,

Je voudrais inclure dans un classeur, une macro permettant la sauvegarde du fichier sur un support clé, disque dur externe etc...

Je n'ai rien trouvé sur le Forum est-ce possible ?
Merci pour votre aide
Lisa

 

[fred65200]

Re : Macro pour Sauvergarde du classe sur Clé ou autre support

bonjour,

code brute à adapter et mettre des conditions de choix de lecteur

ActiveWorkbook.SaveAs Filename:="[SIZE=3][B]F[/B][/SIZE]:\Classeur3.xlsm"

cordialement

 

[Lisa]

Re : Macro pour Sauvergarde du classe sur Clé ou autre support

Merci, je vais chercher pour les conditions ou ouverture boite de dialogue ?
Lisa

 

[fred65200]

Re : Macro pour Sauvergarde du classe sur Clé ou autre support

bonjour, un petit exemple
pour l'utiliser

Ajoute un Userform au projet
Sur ce userform,
place un contrôle ListView nommé ListView1
place un contrôle CommandButton nommé CommandButton1
Colle le code qui suit dans le module de code du UserForm.

Option Explicit
Public Lecteur As String
'---------------------------------------------------------------------
'Avant utilisation
'Ajoute un Userform au projet
'Sur ce userform,
'  place un contrôle ListView nommé ListView1
'  place un contrôle CommandButton nommé CommandButton1
'---------------------------------------------------------------------
Private Sub ChoisirLecteur()
Dim maSelection As Object
On Error GoTo Fin
    Set maSelection = ListView1.SelectedItem
    If maSelection Is Nothing Then MsgBox "Aucune sélection!": Exit Sub
Lecteur = ListView1.SelectedItem
' enregistrement
ActiveWorkbook.SaveAs Filename:=Lecteur & ActiveWorkbook.Name
Fin:
Unload Me
End Sub

Private Sub CommandButton1_Click()
ChoisirLecteur
End Sub

Private Sub ListView1_DblClick()
ChoisirLecteur
End Sub

Private Sub UserForm_Initialize()
Dim Obj_fso As Object
Set Obj_fso = CreateObject("Scripting.FileSystemObject") '
Dim d 'As Drive
Dim tmp() As Variant, x As Integer, i As Integer, j As Variant
Dim tabTitreColonne As Variant
Dim tabLargColonne As Variant
Dim maStr As String
Dim Largeur As Integer

tabTitreColonne = Array("Lecteur", "Nom", "Type")
tabLargColonne = Array(50, 50, 50)

   For Each d In Obj_fso.Drives
      If d.IsReady Then
         ReDim Preserve tmp(0 To 2, 0 To x)
         tmp(0, x) = d.RootFolder 'Path
         tmp(1, x) = d.VolumeName
            Select Case d.DriveType
               Case 0: maStr = "Inconnu"
               Case 1: maStr = "Amovible "
               Case 2: maStr = "Fixe"
               Case 3: maStr = "Réseau"
               Case 4: maStr = "CD -ROM"
               Case 5: maStr = "Mémoire virtuelle"
            End Select
      tmp(2, x) = maStr
      x = x + 1
      End If
   Next

   With ListView1
      .Top = 6
      .Left = 6
      For i = 0 To UBound(tabLargColonne)
         Largeur = Largeur + tabLargColonne(i)
      Next i
      .Width = Largeur + 5
      .Height = 82
      'interdiction de selection multiple
      .MultiSelect = False
      'quadrillage
      .Gridlines = True
      'selection de ligne complete
      .FullRowSelect = True
      'modification colonne 1 interdite
      .LabelEdit = 1
   
      'Remplissage du ListView
      For i = 0 To UBound(tmp, 2)
         .ColumnHeaders.Add , tmp(0, i), tabTitreColonne(i), tabLargColonne(i)
         .ListItems.Add , , tmp(0, i)
         .ListItems(i + 1).ListSubItems.Add , , tmp(1, i)
         .ListItems(i + 1).ListSubItems.Add , , tmp(2, i)
      Next i
   
   'premiere ligne nonsélectionnée
   .ListItems(1).Selected = False
   Set .SelectedItem = Nothing
   
   'Spécifie l'affichage en mode "Détails"
   .View = lvwReport
   End With
   
   Me.Width = 6 + ListView1.Width + 3 + 6
   With CommandButton1
      .Top = ListView1.Top + ListView1.Height + 3
      .Width = 40
      .Height = 20
      .Left = Me.Width - .Width - 6 - 3
   End With
   Me.Height = 6 + 15 + ListView1.Height + 6 + CommandButton1.Height + 6
   Me.Caption = "Choisissez le lecteur"

End Sub

cordialement

 

[Lisa]

Re : Macro pour Sauvergarde du classe sur Clé ou autre support

Bonjour et merci pour votre aide, mais je suis débutante c'est quoi un

un contrôle ListView ?

liste déroulante ?

D'avance merci pour votre réponse
Lisa

 

[MichelXld]

Re : Macro pour Sauvergarde du classe sur Clé ou autre support

bonsoir

c'est quoi un un contrôle ListView ?

Utiliser le contrôle ListView en VBA Excel - Club d'entraide des développeurs francophones

Utiliser les UserForm en VBA Excel - Club d'entraide des développeurs francophones

Utiliser les contrôles dans un UserForm, en VBA Excel - Club d'entraide des développeurs francophones

Merci, je vais chercher pour les conditions ou ouverture boite de dialogue ?

je n'ai pas compris le sens de cette phrase


A tout hasard ...
Il est possible de renommer préalablement la clé pour l'identifier plus facilement dans la procédure (Drv.VolumeName).
Un exemple qui boucle sur les lecteurs amovibles, qui enregistre le classeur si le nom de la clé est trouvé et si le lecteur est prêt:

Sub Sauvegarde_Sur_LecteurAmovible()
    Dim FSO As Object
    Dim Drv As Object
    
    'Correspond au nom que vous avez préalablement attribué à votre clé.
    Const Cible As String = "MaCle"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    On Error Resume Next
    For Each Drv In FSO.Drives
        If Drv.DriveType = 1 Then
            If Drv.VolumeName = UCase(Cible) And Drv.IsReady Then
                ThisWorkbook.SaveAs Drv.DriveLetter & ":\Nom classeur.xls" ', xlWorkbook '(pour xl2007)
                Exit Sub
            End If
        End If
    Next
    
    MsgBox "Enregistrement non effectué." & vbCrLf & _
        "Le lecteur amovible '" & Cible & "' n'a pas été trouvé."
End Sub

Bonne soirée
MichelXld