Speicher des Benutzerformulars

erik_a · 20. August 2025 um 14:48

Hallo an alle

Ich habe ein Problem mit meinem Code unten. Über ein Benutzerformular kann ich eine Revisionstabelle verwalten. Aber wenn ich die Aufnahme ändere. Die Daten aus dem zuvor verwendeten MEP bleiben trotz der Entladungen , die ich einfügen konnte, für das aktuelle MEP im Speicher. Wenn versehentlich eine Validierung im Benutzerformular vorgenommen wird, werden die Daten des neuen MEP überschrieben. Um dies zu beheben, muss ich derzeit das Programm abbrechen und neu starten, damit die Daten ordnungsgemäß vom MEP geladen/abgerufen werden. Weiß jemand von euch, wie man das Problem beheben kann?

Der Kodex

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swModelDocExt   As ModelDocExtension
Dim swCustProp      As CustomPropertyManager
Dim swDraw          As SldWorks.DrawingDoc
Dim bRet            As Boolean
Dim iAddProp        As Integer
Dim lretVal         As Long
Dim sProp(14)       As String
Dim ValeursUsF(14) As String

Sub main()

Dim swApp            As SldWorks.SldWorks
Dim swModel          As SldWorks.ModelDoc2
Dim Filepath         As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

On Error Resume Next

' Vérification si un plan est ouvert

If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
swApp.SendMsgToUser ("Macro utilisable uniquement pour les plans. Veuillez ouvrir un plan et réessayer")

 'Si mauvais format de fichier ouvert alors on ferme la macro
 
Exit Sub

End If

Filepath = swModel.GetPathName

'**********************************************************
' Vérification si fichier enregistrer
'**********************************************************

    If Filepath = "" Then
    
        TabRev.Hide
        Unload TabRev
   
        MsgBox "Veuillez enregistrer le plan au préalable!", vbCritical
        
    Exit Sub

    End If

Load TabRev
TabRev.Show

End Sub

Sub Tableprop()

sProp(0) = "REV1": sProp(1) = "DATE1": sProp(2) = "NOM1": sProp(3) = "MODIF1": sProp(4) = "NOMVERIF1"
sProp(5) = "REV2": sProp(6) = "DATE2": sProp(7) = "NOM2": sProp(8) = "MODIF2": sProp(9) = "NOMVERIF2"
sProp(10) = "REV3": sProp(11) = "DATE3": sProp(12) = "NOM3": sProp(13) = "MODIF3": sProp(14) = "NOMVERIF3"

End Sub

Sub TableValeurTableau()

'Chaque champs du userform
ValeursUsF(0) = TabRev.Bx0.Value: ValeursUsF(1) = TabRev.Bx1.Value: ValeursUsF(2) = TabRev.Bx2.Value: ValeursUsF(3) = TabRev.Bx3.Value: ValeursUsF(4) = TabRev.Bx4.Value
ValeursUsF(5) = TabRev.Bx5.Value: ValeursUsF(6) = TabRev.Bx6.Value: ValeursUsF(7) = TabRev.Bx7.Value: ValeursUsF(8) = TabRev.Bx8.Value: ValeursUsF(9) = TabRev.Bx9.Value
ValeursUsF(10) = TabRev.Bx10.Value: ValeursUsF(11) = TabRev.Bx11.Value: ValeursUsF(12) = TabRev.Bx12.Value: ValeursUsF(13) = TabRev.Bx13.Value: ValeursUsF(14) = TabRev.Bx14.Value

End Sub

Sub MajMEP()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

Call Tableprop
Call TableValeurTableau

For i = 0 To UBound(sProp)
    If sProp(i) <> "" Then
        lretVal = swCustProp.Set2(sProp(i), ValeursUsF(i))
    End If
Next i

End Sub

Sub RecupValMEP()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

Call Tableprop
Call TableValeurTableau

Dim Val As String
Dim resolved As Boolean
Dim Title As String

For i = 0 To UBound(sProp)
    If sProp(i) <> "" Then
        lretVal = swCustProp.Get5(sProp(i), False, ValeursUsF(i), Title, resolved)
    End If
    
Next i

For i = 0 To UBound(ValeursUsF)

TabRev("Bx" & i).Value = ValeursUsF(i)

Next

End Sub

und den UserForm-Code

Private Sub BtnAjout_Click()

'verrouillage du boutons "ajouter un indice" si tableau non remplit (sinon la première ligne est vidée)

If Bx0.Value <> "" And Bx4.Value <> "" And Bx8.Value <> "" Then
    BtnAjout.Enabled = False
        Else
    BtnAjout.Enabled = True
End If

'Copie de ligne 2 à la place de la 1
Bx0.Value = Bx5.Value
Bx1.Value = Bx6.Value
Bx2.Value = Bx7.Value
Bx3.Value = Bx8.Value
Bx4.Value = Bx9.Value

'Copie de ligne 3 à la place de la 2

Bx5.Value = Bx10.Value
Bx6.Value = Bx11.Value
Bx7.Value = Bx12.Value
Bx8.Value = Bx13.Value
Bx9.Value = Bx14.Value

' Suppression de la ligne n°3

Bx10.Value = ""
Bx11.Value = ""
Bx12.Value = ""
Bx13.Value = ""
Bx14.Value = ""

End Sub

Private Sub BtnAnnuler_Click()

Unload TabRev
TabRev.Hide

End Sub

Private Sub BtnOK_Click()

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

'Mise à jour du cartouche selon les données du userform
Call MajMEP

'Reconstruction pour affichage valeurs
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = Part.EditRebuild3()

Unload TabRev
TabRev.Hide

End Sub

Private Sub BtnReset_Click()

'Effacement des 3 lignes
For i = 0 To 14
    Me.Controls("Bx" & i).Value = " "
Next i

End Sub

Private Sub Bx8_Change()

'Verrouillage du bouton "Ajouter un indice" si tableau pas entiérement remplit (sinon la première ligne est vidée)

If Bx0.Value <> "" And Bx5.Value <> "" And Bx10.Value <> "" Then
    BtnAjout.Enabled = True
        Else
    BtnAjout.Enabled = False
End If

End Sub

Private Sub CmdBtn1_Click()

Bx1.Value = DateValue(Date)

End Sub

Private Sub CmdBtn2_Click()

Bx6.Value = DateValue(Date)

End Sub

Private Sub CmdBtn3_Click()

Bx11.Value = DateValue(Date)

End Sub

Private Sub UserForm_Initialize()

'Récupération valeurs présente sur la MEP, pour màj userform

Call RecupValMEP

'Verrouillage du bouton "Ajouter un indice" si tableau pas entiérement remplit (sinon la première ligne est vidée)

If Bx0.Value <> "" And Bx5.Value <> "" And Bx10.Value <> "" Then
    BtnAjout.Enabled = True
        Else
    BtnAjout.Enabled = False
End If

'Remplissage des listes déroulantes

Bx2.AddItem "P.NOM1"
Bx2.AddItem "P.NOM2"
Bx2.AddItem "P.NOM3"
Bx2.AddItem "P.NOM4"
Bx2.AddItem "P.NOM5"
Bx2.AddItem "P.NOM6"

Bx7.AddItem "P.NOM1"
Bx7.AddItem "P.NOM2"
Bx7.AddItem "P.NOM3"
Bx7.AddItem "P.NOM4"
Bx7.AddItem "P.NOM5"
Bx7.AddItem "P.NOM6"

Bx12.AddItem "P.NOM1"
Bx12.AddItem "P.NOM2"
Bx12.AddItem "P.NOM3"
Bx12.AddItem "P.NOM4"
Bx12.AddItem "P.NOM5"
Bx12.AddItem "P.NOM6"

End Sub

Vielen Dank im Voraus

Maclane · 20. August 2025 um 15:31

Hallo;

Wenn Sie die TabRev nur verschieben möchten, würde ich sie an das Ende der Funktion setzen
Private Sub BtnAjout_Click()

kurz vor dem " Ende Sub " aber es ist nicht sehr benutzerfreundlich .

Stattdessen schlage ich vor:

In der Hauptroutine (Main) haben Sie den Pfad der aktiven Zeichnung abgerufen:
Filepath = swModel.GetPathName

Um es einfach auszudrücken, füge ich eine Überprüfung des Namens der aktuellen Datei in der Routine hinzu:

Private Sub BtnAjout_Click()

FilepathTest = swModel.GetPathName

und einen bedingten Block des Stils:

if FilepathTest <> Filepath then

Dim reponse As Integer
reponse = MsgBox("Attention, ce n'est plus la même Mise En Plan ! Souhaitez-vous continuer malgré le risque ?", vbYesNo + vbExclamation, "Avertissement")
If reponse = vbYes Then
    ' Code pour continuer
Else
    ' Code pour annuler 
Unload TabRev
End If

Persönliche Anmerkung: Zögern Sie nicht, im VB-Editor die " Schritt-für-Schritt -" Funktion (F8) zu verwenden, die es Ihnen ermöglicht, die Ausführung der Codes zu verstehen...

erik_a · 21. August 2025 um 10:16

Hallo Maclane,

Das Hinzufügen zur Funktion Private Sub BtnAjout_Click() funktioniert nicht, diese Funktion wird verwendet, um eine Zeile zu verschieben, um Platz für eine neue zu schaffen, falls sie alle gefüllt sind.

Bei der zweiten Option löst es mein Problem nicht. Wenn ich mich entscheide, mit dem Laden der Daten fortzufahren, muss ich das Programm abbrechen und neu starten, damit das Laden korrekt ist. Aber trotzdem danke.

In der Tat ist F8 sehr gut. Ich praktiziere es bereits

Maclane · 21. August 2025 um 11:39

Hallo;
Ich habe tatsächlich etwas Dummes gesagt, es steht am Ende von
BtnOK_Click() dass wir das Unload TabRev...

Und das Gleiche gilt für die bedingte Funktion, Sie müssen sich die " Main " -Prozedur merken, um die Wiederholung der Daten des neuen Blattes zu erzwingen... Abhängig von der Wahl, die Sie mit der Message Box getroffen haben...

Eine andere Methode ist mit einem " event " möglich, um die Variable " Filepath " in Echtzeit zu überwachen:

Beispiel: ( zum Einfügen eines Klassenmoduls mit dem Namen clsSwEvents)

Public WithEvents swApp As SldWorks.SldWorks
Private prevPath As String

Private Sub Class_Initialize()
    Set swApp = Application.SldWorks
    prevPath = ""
End Sub

Private Sub swApp_ActiveDocChangeNotify()
    Dim swModel As ModelDoc2
    Dim Filepath As String

    Set swModel = swApp.ActiveDoc
    If Not swModel Is Nothing Then
        Filepath = swModel.GetPathName
        If Filepath <> prevPath Then
            MsgBox "Changement détecté ! Nouveau chemin : " & Filepath
            prevPath = Filepath
        End If
    End If
End Sub

und fügen Sie in der " Main " -Prozedur hinzu:

    Set swEvents = New clsSwEvents
    MsgBox "Surveillance des changements de chemin activée." '(Facultatif)

erik_a · 21. August 2025 um 13:10

Vielen Dank für all diese Ideen.
Beim Ausprobieren Ihrer Lösung mit der bedingten Funktion wurde mir klar, dass es schließlich ausreichte, am Ende der Routine (Hand)

Unload.TabRev
TabRev.hide

vor

Load.TabRev
TabRev.show

Auf diese Weise können Sie endlich das erneute Laden der Daten erzwingen, sobald das Programm gestartet wird. Ich hatte diese Möglichkeit noch nie ausprobiert oder nicht in der Hauptsache.

Vielen Dank

Maclane · 21. August 2025 um 13:16

… Ich dachte, Sie möchten Ihr Makro nicht jedes Mal anhalten und neu starten müssen, wenn Sie Ihr Solidworks-Dokument ändern...

erik_a · 21. August 2025 um 13:20

Ich war mir nicht klar, tut mir leid.

Wenn zwischen 2 verschiedenen Dateien kein Problem. Ich musste dies für eine einzelne Datei tun → klicken, um das Programm zu starten, es rückgängig zu machen und neu zu starten. wissend, dass, wenn ich das Programm abbreche, die vorherige Datei nicht im Speicher bleibt.

Maclane · 21. August 2025 um 13:56

Ich kann es Ihnen nicht verübeln, ich war auch nicht sehr effizient in meinen Antworten
Die Hauptsache ist, dass das Problem gelöst ist.