Fenster "Als speichern"

Macro
21

Haha, okay :rofl: . Der Codeausschnitt, den ich gegeben habe, ist nur ein Beispiel, um das Fenster zu haben, um den Pfad auszuwählen, aber zu keinem Zeitpunkt wird gespeichert, dass man es anpassen und einen SaveAs3 einfügen muss. :sweat_smile:

1 „Gefällt mir“
22

Okay, ich verstehe es besser, wenn Revnche dieses Fenster speichert und eine Kopie am angegebenen Ort speichert...

image
Bild984×659 85 KB

Andererseits, wenn du entkommst, geht das Fenster in den Hintergrund und es ist unmöglich, dieses Fenster zu finden, sodass SW erzwungen abstürzt.
Ich denke, ich werde das Excel-Fenster behalten, das sehr gut funktioniert.
Und wenn ein Softwareentwickler vorbeigeht, könnte die VBA-Funktion auch nützlich sein!

23

Ich kann dich nicht mit einem Excel-Fenster allein lassen, ich würde heute Nacht nicht schlafen :rofl:
Hier ist der vollständige Code zum Speichern. Ich habe getestet, dass es zu Hause funktioniert

Option Explicit

' ==============================================================================
' DÉCLARATIONS API WINDOWS
' ==============================================================================
#If VBA7 Then
    Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
#Else
    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
#End If

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
End Type


' ==============================================================================
' PROCÉDURE MAIN
' ==============================================================================
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swDoc As SldWorks.ModelDoc2
    Dim swModelExt As SldWorks.ModelDocExtension
    Dim savePath As String
    Dim lErrors As Long
    Dim lWarnings As Long
    Dim boolStatus As Boolean
    
    ' 1. Connexion à SolidWorks
    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    
    If swDoc Is Nothing Then
        MsgBox "Aucun document ouvert dans SolidWorks.", vbExclamation
        Exit Sub
    End If
    
    ' 2. Boîte de dialogue pour récupérer le chemin de destination
    savePath = ShowWin32SaveFileDialog("Pièce SolidWorks (*.sldprt)" & vbNullChar & "*.sldprt" & vbNullChar, "sldprt")
    
    ' Annulation / Echap
    If savePath = "" Then Exit Sub
    
    ' S'assurer de l'extension .sldprt
    If LCase(Right(savePath, 7)) <> ".sldprt" Then
        savePath = savePath & ".sldprt"
    End If

    ' 3. Récupération de l'extension du document
    Set swModelExt = swDoc.Extension
    
    ' 4. Utilisation de IModelDocExtension::SaveAs
    ' Signature : SaveAs(Name, Version, Options, ExportData, Errors, Warnings)
    boolStatus = swModelExt.SaveAs(savePath, _
                                  swSaveAsCurrentVersion, _
                                  swSaveAsOptions_Silent, _
                                  Nothing, _
                                  lErrors, _
                                  lWarnings)

    ' 5. Résultat
    If boolStatus Then
        MsgBox "Pièce enregistrée avec succès :" & vbCrLf & savePath, vbInformation
    Else
        MsgBox "Échec de l'enregistrement." & vbCrLf & _
               "Code d'erreur SOLIDWORKS API : " & lErrors & vbCrLf & _
               "Code d'avertissement : " & lWarnings, vbCritical
    End If
End Sub


' ==============================================================================
' BOÎTE DE DIALOGUE WINDOWS NATIVE
' ==============================================================================
Function ShowWin32SaveFileDialog(ByVal filter As String, Optional ByVal defaultExt As String = "") As String
    Dim ofn As OPENFILENAME
    Dim result As Long
    
    ofn.lStructSize = LenB(ofn)
    ofn.lpstrFilter = filter
    ofn.lpstrFile = Space$(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space$(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrTitle = "Enregistrer la pièce sous..."
    ofn.flags = &H2 Or &H4 ' OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST
    ofn.lpstrDefExt = defaultExt
    
    result = GetSaveFileName(ofn)
    
    If result <> 0 Then
        ShowWin32SaveFileDialog = Trim$(Replace(ofn.lpstrFile, vbNullChar, ""))
    Else
        ShowWin32SaveFileDialog = ""
    End If
End Function
24

Danke fürs Teilen, es funktioniert super.
Ich habe außerdem OpenFilename und ShowWin32SaveFileDialog entdeckt (das teilweise im @Maclane-Link auf Codestack war, aber offensichtlich habe ich von dieser Funktion nichts verstanden!
Andererseits habe ich heute keine Zeit, zum ursprünglichen Makro zurückzukehren, um es zu modifizieren, ich hoffe, es stört deinen Abend nicht zu sehr!

Und danke für die Entdeckung!

25

OPENFILENAME ist nicht native für VBA, dieser Typ wurde im Code über den privaten Typ OPENFILENAME erstellt

1 „Gefällt mir“