Venster Opslaan als

Macro
21

Ha, oké :rofl: . Het stukje code dat ik gaf is slechts een voorbeeld om het venster te hebben om het pad te kiezen, maar op geen enkel moment moet je het aanpassen en een SaveAs3 plaatsen. :sweat_smile:

1 like
22

Oké, ik begrijp het beter door Revnche, dit venster toont 'save en slaat een kopie' op op de aangegeven locatie...

image
afbeelding984×659 85 KB

Aan de andere kant, als je vlucht, gaat het venster naar de achtergrond en is het onmogelijk om dit venster te vinden, dus crasht SW geforceerd.
Ik denk dat ik het Excel-venster ga behouden, dat werkt heel goed.
En als een softwareontwikkelaar voorbijgaat, kan de VBA-functie ook handig zijn!

23

Ik kan je niet achterlaten met een Excel-venster, ik zou vannacht niet slapen :rofl:
Hier is de volledige code om op te slaan. Ik heb getest dat het thuis werkt

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

Bedankt voor het delen, het werkt prima.
Ik ontdekte ook openfilename en ShowWin32SaveFileDialog (die deels in de @Maclane link op Codestack stonden, maar ik begreep natuurlijk niets van deze functie!
Aan de andere kant heb ik vandaag geen tijd om terug te gaan naar de originele macro voor aanpassing, ik hoop dat het je avond niet te veel verstoort!

En bedankt voor de ontdekking!

25

OPENFILENAME is niet native in VBA, dit type is in de code aangemaakt via Private Type OPENFILENAME

1 like