Userform memory

Macro
1

Hello everyone,

I have a problem with my code below. Via a userform, it allows me to manage a revision table. But when I change the shot. The data from the previously used MEP remains in memory for the current one, despite the unloads I was able to put in. If by mistake a validation is made in the userform, it overwrites the data of the new MEP. To fix this, currently, I need to cancel and restart the prog so that the data is properly loaded/retrieved from the MEP. Do any of you know how to fix it?

image

The 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

and the 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

thank you in advance :slight_smile:

2

Hello;

If you just want to move the Unload TabRev I would put it at the end of the function
Private Sub BtnAjout_Click()

just before the " end sub " but it's not very user-friendly  .

Instead, I propose:

In the main routine (Main) you have retrieved the path of the active drawing:
Filepath = swModel.GetPathName

To put it simply, I'll add a check of the name of the current file in the routine:

Private Sub BtnAjout_Click()

FilepathTest = swModel.GetPathName

and a conditional block of the style:

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

Personal note: In the VB editor, never hesitate to use the " step-by-step " function (F8) this allows you to understand the execution of the codes...

2 Likes
3

Hello Maclane,

adding it to the Private Sub BtnAjout_Click() function doesn't work, this function is used to shift one line to make room for a new one in case they are all filled.

For the second option, it doesn't solve my problem. If I choose to continue the data loading remains the same, I will have to cancel and restart the program so that the loading is correct. But thank you anyway.

Indeed F8 is very good. I already practice it :wink:

4

Hello;
I actually said something stupid :crazy_face: , it's at the end of
BtnOK_Click() that we should add the Unload TabRev...

And it's the same thing for the conditional function, you have to remember the " Main " procedure to force the replay of the data of the new sheet... Depending on the choice made with the Message Box...

Another method is possible with an " event " to monitor the " Filepath " variable in real time:

example: ( to put in a class module named 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

and add in the " Main " procedure:

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

Thank you for all these ideas.
While trying your solution with the conditional function, I realized that finally, at the end of the routine (hand), it was enough to add

Unload.TabRev
TabRev.hide

before

Load.TabRev
TabRev.show

This finally allows you to force the reloading of the data as soon as the program is launched. I hadn't tried this possibility before or not in the main. :crazy_face:

Thank you :slight_smile:

6

… I thought you didn't want to have to stop and restart your macro every time you change your Solidworks document...

1 Like
7

I wasn't clear, sorry.

If between 2 different files no problem. I had to do this for a single file → click to launch the prog, undo and restart the prog. knowing that if I cancel the program not keep the previous file in memory.

1 Like
8

:grin::grin:I can't blame you, I wasn't very efficient in my answers either:sweat_smile:
The main thing is that the problem is solved. :+1:

2 Likes