Geheugen van het gebruikersformulier

erik_a · 20 augustus 2025 om 14:48

Hallo allemaal,

Ik heb een probleem met mijn onderstaande code. Via een gebruikersformulier kan ik een revisietabel beheren. Maar als ik het schot verander. De gegevens van de eerder gebruikte MEP blijven in het geheugen van de huidige, ondanks de ontladingen die ik erin heb kunnen stoppen. Als er per ongeluk een validatie wordt uitgevoerd in het gebruikersformulier, worden de gegevens van het nieuwe Europarlementariër overschreven. Om dit op te lossen, moet ik momenteel het programma annuleren en opnieuw opstarten, zodat de gegevens correct worden geladen/opgehaald van het MEP. Weet iemand van jullie hoe je het kunt oplossen?

De Code

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

en de code van het gebruikersformulier

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

Bij voorbaat dank

Maclane · 20 augustus 2025 om 15:31

Hallo;

Als je alleen de Unload TabRev wilt verplaatsen, zou ik deze aan het einde van de functie plaatsen
Private Sub BtnAjout_Click()

net voor de " einde sub " maar het is niet erg gebruiksvriendelijk .

In plaats daarvan stel ik voor:

In de hoofdroutine (Main) heb je het pad van de actieve tekening opgehaald:
Filepath = swModel.GetPathName

Simpel gezegd, ik zal een controle van de naam van het huidige bestand in de routine toevoegen:

Private Sub BtnAjout_Click()

FilepathTest = swModel.GetPathName

en een voorwaardelijk blok van de stijl:

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

Persoonlijke noot: Aarzel nooit om in de VB-editor de functie " stap-voor-stap " (F8) te gebruiken, hiermee kunt u de uitvoering van de codes begrijpen...

erik_a · 21 augustus 2025 om 10:16

Hallo Maclane,

het toevoegen aan de Private Sub BtnAjout_Click() functie werkt niet, deze functie wordt gebruikt om een regel te verschuiven om ruimte te maken voor een nieuwe voor het geval ze allemaal gevuld zijn.

Voor de tweede optie lost het mijn probleem niet op. Als ik ervoor kies om door te gaan, blijft het laden van de gegevens hetzelfde, ik moet het programma annuleren en opnieuw opstarten zodat het laden correct is. Maar toch bedankt.

F8 is inderdaad erg goed. Ik oefen het al

Maclane · 21 augustus 2025 om 11:39

Hallo;
Ik zei eigenlijk iets stoms , het is aan het einde van
BtnOK_Click() dat we de Unload TabRev...

En hetzelfde geldt voor de voorwaardelijke functie, je moet de " Main " procedure onthouden om het opnieuw afspelen van de gegevens van het nieuwe blad te forceren... Afhankelijk van de keuze die gemaakt is met de Message Box...

Een andere methode is mogelijk met een " event " om de variabele " Filepath " in realtime te monitoren:

voorbeeld: ( om in een klassemodule met de naam clsSwEvents te plaatsen)

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

en voeg in de " Main " procedure toe:

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

erik_a · 21 augustus 2025 om 13:10

Bedankt voor al deze ideeën.
Terwijl ik je oplossing met de voorwaardelijke functie probeerde, realiseerde ik me dat het uiteindelijk, aan het einde van de routine (hand), voldoende was om toe te voegen

Unload.TabRev
TabRev.hide

voor

Load.TabRev
TabRev.show

Dit stelt u ten slotte in staat om het opnieuw laden van de gegevens te forceren zodra het programma wordt gestart. Ik had deze mogelijkheid nog niet eerder geprobeerd of niet in het algemeen.

Bedankt

Maclane · 21 augustus 2025 om 13:16

… Ik dacht dat je niet wilde stoppen en je macro opnieuw opstarten telkens wanneer je je Solidworks-document wijzigt ...

erik_a · 21 augustus 2025 om 13:20

Ik was niet duidelijk, sorry.

Indien tussen 2 verschillende bestanden geen probleem. Ik moest dit doen voor een enkel bestand → klikken om de prog te starten, ongedaan te maken en opnieuw te starten. wetende dat als ik het programma annuleer, ik het vorige bestand niet in het geheugen bewaar.

Maclane · 21 augustus 2025 om 13:56

Ik kan het je niet kwalijk nemen, ik was ook niet erg efficiënt in mijn antwoorden
Het belangrijkste is dat het probleem is opgelost.