Mémoire userform

erik_a · Août 20, 2025, 2:48

Bonjour à tous et toutes,

J’ai un soucis avec mon code ci-dessous. Via un userform, il me permet de gérer une table de révision. Or lorsque je change de mise en plan. Les données de la MEP précédemment utilisée reste en mémoire pour la nouvelle en cours, malgré les unload que j’ai pu mettre. Si par erreur une validation est faite dans le userform cela écrase les données de la nouvelle MEP. Pour y remédier, actuellement, je dois annuler et relancer le prog pour que les données soit correctement chargée/récupérée de la MEP. L’un/une de vous saurait comme y remédier?

Le 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

et le code du userform

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

merci d’avance

Maclane · Août 20, 2025, 3:31

Bonjour;

Si vous voulez juste deplacer le Unload TabRev je le mettrais à la fin de la fonction
Private Sub BtnAjout_Click()

juste avant le « end sub » mais ce n’est pas très « user-friendly ».

A la place je propose:

Dans la routine principale (Main) vous avez récupéré le chemin de la mise en plan active:
Filepath = swModel.GetPathName

pour faire simple, j’ajouterai un contrôle du nom du fichier en cours dans la routine :

Private Sub BtnAjout_Click()

FilepathTest = swModel.GetPathName

et un bloc conditionnel du 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

Note personnelle : Dans l’editeur VB, ne jamais hésiter à utiliser la fonction « pas-a-pas » (F8) cela permet de bien comprendre l’execution des codes…

erik_a · Août 21, 2025, 10:16

Bonjour Maclane,

l’ajout dans la fonction Private Sub BtnAjout_Click() ne donne rien, cette fonction sert à décaler d’une ligne pour laisser la place à une nouvelle dans le cas ou elle sont toutes remplies.

Pour la seconde option, cela ne règle pas mon problème. si je choisit continuer le chargement des données reste le même, il faudra faire annuler et relancer le prog pour que le chargement correctement. Mais merci quand même.

Effectivement F8 est très bien. Je le pratique déjà

Maclane · Août 21, 2025, 11:39

bonjour;
j’ai effectivement dis une bêtise , c’est à la fin de
BtnOK_Click() qu’il faudrait ajouter le Unload TabRev…

Et c’est la même chose pour la fonction conditionnelle, il faut rappeler la procédure « Main » pour forcer la relecture des données de la nouvelle feuille…selon le choix réalisé avec le message box…

un autre méthode est possible avec un « event » pour surveiller la variable « Filepath » en temps réel:

exemple: ( a mettre dans un module de classe nommé 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

et ajouter dans la procedure « Main »:

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

erik_a · Août 21, 2025, 1:10

Merci pour toutes ces idées.
En essayant ta solution avec la fonction conditionnelle, je me suis rendu compte que finalement, à la fin de la routine (main), il suffisait d’ajouter

Unload.TabRev
TabRev.hide

avant

Load.TabRev
TabRev.show

Ce qui finalement permet de forcer le rechargement des données dès le lancement du prog. Je n’avais pas du essayer cette possibilité auparavant ou pas dans le main.

Merci

Maclane · Août 21, 2025, 1:16

… je croyais que tu ne voulais pas à avoir à arrêter et relancer ta macro à chaque changement de document Solidworks …

erik_a · Août 21, 2025, 1:20

Je n’ai pas été clair désolé.

Si entre 2 fichiers différents pas de problème. Je devais le faire pour un seul fichier → clique pour lancer le prog, annuler et relance le prog. sachant que si j’annuler pas le prog garder en mémoire le fichier précédent.

Maclane · Août 21, 2025, 1:56

j’peux pas t’en vouloir, je n’ai pas été très performant dans mes réponses moi non plus
L’essentiel est que le problème soit résolu.