Enregistrer sauvegardes via un Userform

Bonjour , j'ai travaillé sur un userform pour saugarder des fichiers Excel que je recherche au préalable .
Pouvez vous m'aider pour épurer ces codes ?

Et aussi pour écrire le code pour enregistrer le classeur actuel dans les différents résultats trouvés ? Je ne vois pas trop comment faire.

En vous remerciant par avance pour vos propositions.

Bonjour Sev44

"Vous avez" travaillé sur l'USF ce fichier a été créé par P. TOULON et code modifier par Jurassic Pork...

Enfin, bref, que voulez-vous enregistrer ?

A+

Bonsoir , oui effectivement c'est un début de code que je voudrais adapter.

Lors de la fermeture d'un classeur nommé A1 , l'Userform s'ouvre. A ce moment il faudrait enregistrer ce classeur ouvert avec les noms des 4 fichiers des listboxs vers les chemins de ces listboxs.

Bonjour le fil

Cross posting Du coup je répond sur ce fil...

Sev44, Si le but (que je ne comprends pas) est effectivement de sauvegarder le classeur actuel sous divers répertoires et noms. Alors que vous faut-il ?

Une petite fonction « GetFilesFullPath() » qui retourne un tableaux des différents chemins (seulement des listes déroulantes dont le type est "SaveFolderPath").

'@Description "récupère les chemins des classeurs à sauvegarder."
Public Function GetFilesFullPath(ByVal frm As Object) As Variant
    Dim Count As Long
    Count = -1

    Dim ctrl As Control
    For Each ctrl In frm.Controls
        If TypeName(ctrl) = "ComboBox" Then
            If StrComp(GetTheValue(ctrl.Tag, "Type"), "SaveFolderPath") = 0 Then
                If Not IsNull(ctrl.value) Then
                    If Trim$(CStr(ctrl.value)) <> vbNullString Then
                        Count = Count + 1
                        If Count = 0 Then
                            Dim Result() As Variant
                            ReDim Result(0 To 0)
                        Else
                            ReDim Preserve Result(0 To Count)
                        End If
                        Result(Count) = ctrl.value
                    End If
                End If
            End If
        End If
    Next ctrl
    If Count = -1 Then
        GetFilesFullPath = Array()
    Else
        GetFilesFullPath = Result
    End If
End Function

Une petite fonction « GetTheValue() »qui récupère une valeur selon une clé.

'@Description "Extracts the value associated with a key from a semicolon-delimited Key:=Value string."
Public Function GetTheValue(ByVal strTag As String, _
                            ByVal strKey As String _
                            ) As String

    If LenB(strTag) = 0 Or LenB(strKey) = 0 Then Exit Function

    Dim elements() As String
    elements = Split(strTag, ";")

    Dim i As Long
    Dim pos As Long
    Dim currentKey As String

    For i = LBound(elements) To UBound(elements)
        pos = InStr(1, elements(i), ":=", vbTextCompare)
        If pos > 0 Then
            currentKey = Trim$(Left$(elements(i), pos - 1))
            If StrComp(currentKey, strKey, vbTextCompare) = 0 Then
                GetTheValue = Trim$(Mid$(elements(i), pos + 2))
                Exit Function
            End If
        End If
    Next i
End Function

Une fonction « GetValidFullPath() » qui vérifie si le chemin est valide :

Public Function GetValidFullPath(ByVal value As String, _
Optional ByVal Attribut As VbFileAttribute = VbFileAttribute.vbNormal _
) As String

If Dir(Trim$(CStr(value)), Attribut) > vbNullString Then
GetValidFullPath = Trim$(CStr(value))
End If
End Function

Ensuite « CommandButton1_Click() » met tout cela en forme :

Private Sub CommandButton1_Click()
    On Error GoTo Catch

    Dim chemins As Variant
    chemins = xlTools.GetFilesFullPath(frm:=Me)
    If IsArray(chemins) Then
        Dim i As Long
        For i = LBound(chemins) To UBound(chemins)
            Dim validPath As String
            validPath = xlTools.GetValidFullPath(value:=chemins(i))
            If validPath > vbNullString Then
                Application.EnableEvents = False
                ThisWorkbook.SaveCopyAs chemins(i)
            End If
        Next i
    End If

Finally:
    Application.EnableEvents = True
    Exit Sub

Catch:
    If Err.Number > 0 Then
        ' // Do something.
        MsgBox "Oupss... Nous avons rencontré une erreur : " & Err.Number & _
               " (" & Err.Description & ") dans la procédure CommandButton1_Click du Form UsfRechercherFic"

        Resume Finally

    End If

End Sub

Ne pas oublier de changer le .Tag des listes déroulantes concernées avec ceci par exemple "Type:=SaveFolderPath;DefaultValue:=Select..."

Pour ma part je ferais un test supplémentaire au niveau des listes déroulantes pour avertir si plusieurs chemins sont identiques.

Je ne teste pas ce genre de code, dites-nous en retour si c'est bon pour vous.

Edit : Dans CommandButton1_Click() J'ai modifié :

If IsArray(chemins) Then

IsEmpty pouvais renvoyer une information fausse. Il serait même préférable de concocter une petite fonction pour vérifier cela...