Pamięć formularzy użytkownika

erik_a · 20 Sierpień 2025 14:48

Witam wszystkich,

Mam problem z moim kodem poniżej. Za pomocą formularza użytkownika mogę zarządzać tabelką zmian. Ale kiedy zmieniam ujęcie. Dane z poprzednio używanego MEP pozostają w pamięci dla obecnego, pomimo rozładowań , które udało mi się wprowadzić. Jeśli przez pomyłkę zostanie przeprowadzona walidacja w formularzu użytkownika, nadpisuje ona dane nowego MEP. Aby to naprawić, obecnie muszę anulować i ponownie uruchomić program, aby dane zostały poprawnie załadowane/pobrane z MEP. Czy ktoś z Was wie, jak to naprawić?

Kodeks

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

i kod formularza użytkownika

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

Z góry dziękuję

Maclane · 20 Sierpień 2025 15:31

Witam;

Jeśli chcesz po prostu przesunąć Unload TabRev, umieściłbym go na końcu funkcji
Private Sub BtnAjout_Click()

tuż przed " end sub ", ale nie jest zbyt przyjazny dla użytkownika.

Zamiast tego proponuję:

W procedurze main (Main) pobrano ścieżkę aktywnego rysunku:
Filepath = swModel.GetPathName

Mówiąc prościej, dodam sprawdzanie nazwy bieżącego pliku w procedurze:

Private Sub BtnAjout_Click()

FilepathTest = swModel.GetPathName

i blok warunkowy stylu:

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

Uwaga osobista: W edytorze VB nigdy nie wahaj się skorzystać z funkcji " krok po kroku " (F8), która pozwala zrozumieć wykonywanie kodów...

erik_a · 21 Sierpień 2025 10:16

Witaj Maclane,

Dodanie go do funkcji Private Sub BtnAjout_Click() nie działa, ta funkcja służy do przesunięcia jednej linii, aby zrobić miejsce na nową w przypadku, gdy wszystkie są wypełnione.

W przypadku drugiej opcji nie rozwiązuje to mojego problemu. Jeśli zdecyduję się kontynuować ładowanie danych pozostaje takie samo, będę musiał anulować i ponownie uruchomić program, aby ładowanie było poprawne. Ale i tak dziękuję.

Rzeczywiście, F8 jest bardzo dobry. Już to ćwiczę

Maclane · 21 Sierpień 2025 11:39

Witam;
Właściwie powiedziałem coś głupiego , to na końcu
BtnOK_Click() że powinniśmy dodać Unload TabRev...

I to samo dotyczy funkcji warunkowej, musisz pamiętać o procedurze " Main ", aby wymusić odtworzenie danych z nowego arkusza... W zależności od wyboru dokonanego za pomocą okna komunikatów...

Inna metoda jest możliwa z " zdarzeniem " do monitorowania zmiennej " Filepath " w czasie rzeczywistym:

przykład: ( aby umieścić w module klasy o nazwie 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

i dodać w procedurze " Main ":

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

erik_a · 21 Sierpień 2025 13:10

Dziękuję za wszystkie te pomysły.
Wypróbowując Twoje rozwiązanie z funkcją warunkową, zdałem sobie sprawę, że w końcu, na końcu rutyny (ręki), wystarczy dodać

Unload.TabRev
TabRev.hide

przed

Load.TabRev
TabRev.show

To w końcu pozwala wymusić ponowne załadowanie danych zaraz po uruchomieniu programu. Nie próbowałem tej możliwości wcześniej ani w ogóle.

Dziękuję

Maclane · 21 Sierpień 2025 13:16

… Myślałem, że nie chcesz zatrzymywać i ponownie uruchamiać makra za każdym razem, gdy zmieniasz dokument Solidworks...

erik_a · 21 Sierpień 2025 13:20

Nie wyraziłem się jasno, przepraszam.

Jeśli między 2 różnymi plikami nie ma problemu. Musiałem to zrobić dla jednego pliku → kliknąć, aby uruchomić program, cofnąć i ponownie uruchomić program. wiedząc, że jeśli anuluję program, nie zachowaj poprzedniego pliku w pamięci.

Maclane · 21 Sierpień 2025 13:56

Nie mogę cię winić, ja też nie byłem zbyt skuteczny w swoich odpowiedziach
Najważniejsze, że problem został rozwiązany.