IpxBrowser : discussion sur le code VBA

Cartes Ethernet IPX800
2

EDIT par FGTOUL : Post déplacé.

Bonjour @Michel94

Beau boulot, je me posais la question récemment sur ce développement :+1: initié il y a un paquet de mois, j’ai la réponse et quelle réponse ! :clap: :clap: :clap:

Un peti bug relevé en cliquant sur IPX

image
image1184×555 102 KB

« On Error Resume Next » étant placé avant le code en cause cela empêche la poursuite du programme, néanmoins le problème est que cette instruction ne clear pas l’erreur et va propager cette erreur à d’autre endroit dans le programme !

Je te met 3 exemple de sub qui me permettais de gérer les erreurs dans mes progs VB VBA quand j’étais encore à la barre (VB et VBA vers Autocad et système wmi) !
th-3374040504

La première permet d’avoir une trace dans un fichier log, elle est à ajouter dans un module (je l’ai mise dans Module_erreur)

WriteErrLog

’ *************************************************************************
’ * Ecriture fichier erreur log
’ *************************************************************************
Public Sub WriteErrLog(strMsg As String)

On Error GoTo errSub

Dim lFile As Long, lPtr As Long, strWrite As String, strFileErrProg

strFileErrProg = App.Path & IIf(Right(App.Path, 1) = "", «  », "") & « IpxBroser.log »

’ *** si fichier absent ouvre en ecriture sinon en ajout
lFile = FreeFile
If Dir(strFileErrProg, vbNormal) = «  » Then
Open strFileErrProg For Output As lFile
Else
Open strFileErrProg For Append As lFile
End If

’ *** ecrit le msg de log, ferme et quitte
’ renvoie la longueur du fichier
lPtr = LOF(lFile)

’ si longueur = 0 definit le pointeur a 1
If lPtr = 0 Then lPtr = 1

’ positionne le pointeur du fichier
Seek #lFile, lPtr - 2

’ ecrit dans le fichier
Write #lFile, strMsg

’ ferme le fichier
Close lFile
Exit Sub

errSub:
Err.Clear
Resume Next

End Sub

La 2de permet d’ecrire dans ce fichier log en incluant le message passé en paramètre et horodater l’erreur

GestionErr

’ *************************************************************************
’ * Affiche ou ecrit sur disque gestion err
’ *************************************************************************
Public Sub GestionErr(strMsg As String)

Call WriteErrLog(Format(Now, « dd/mm/yyyy hh:mm:ss ») & " - erreur - " & strMsg)

End Sub

image
image1920×1050 141 KB

la 3ème est un exemple qui sert via le wmi de tuer un process (nom du process passé en paramètre, l’erreur est gérée par la ligne suivante à mettre dans toutes les procédures critiques

On Error GoTo errSub

qui en cas d’erreur trace l’erreur et la clear puis poursuit le programme de la sub ou fonction

errSub:
Call GestionErr("Erreur Sub KillProcess : " & Err.Number & " " & Err.Description & vbCrLf)
Err.Clear
Resume Next

image
image1918×910 62.9 KB

le code exemple pour l’appel en cas d’erreur

KillProcess

’ *************************************************************************
’ * Kill les process
’ *************************************************************************
Public Sub KillProcess(strProcess)

On Error GoTo errSub

Dim oWmi, oCol, oObj, lRet As Long

Set oWmi = GetObject(« winmgmts:{impersonationLevel=impersonate}!\.\root\cimv2 »)
Set oCol = oWmi.ExecQuery(« Select * From Win32_Process Where Name = ' » & strProcess & « ' »)
For Each oObj In oCol
lRet = oObj.Terminate()
DoEvents
Next
Set oObj = Nothing
Set oCol = Nothing
Set oWmi = Nothing
Exit Sub

errSub:
Call GestionErr("Erreur Sub KillProcess : " & Err.Number & " " & Err.Description & vbCrLf)
Err.Clear
Resume Next

End Sub

Le prog ne s’arrete plus sur l’erreur

image
image1920×1050 182 KB

cela permet de tracer la sub dans laquelle s’est produit l’erreur et le message d’erreur propre à l’erreur avant qu’elle soit clear et ainsi elle n’est pas propagée

image
image873×169 6.65 KB

Quelques remarques au passage si je puis me permettre de partager mon expérience:
Dim i As Integer a proscrire Dim ii As Integer à préférer (pour le débogage c’est mieux de chercher une variable ii que i ! :wink:
il vaut mieux typer les noms de variables cela évite dans le code de mélanger les genres (notation hongroise)
boNomVariable pour un boolean
iNomVariable pour un integer
dNomVariable pour un double
strNomVariable pour un string
objNomVariable pour un objet
etc
Tu peux utiliser les constante vbLf à la place de Chr(10) vbCr pour Chr(13) et vbCrLf pour Chr(10) + Chr(13)

utiliser un max de width …end with (même si cela ne joue plus beaucoup sur les perfs actuelles c’est plus pour la clarté)

Beaucoup commenter, car j’ai souvenir d’un collègue qui commentait peu et quand il revenait sur du code quelque mois plus tard c’était la cata et surtout pour d’autres qui devaient reprendre le code !

Il est possible d’optimiser le code avec l’utilisation de iif
If errorSheet.Cells(Rows.Count, 1).End(xlUp).row >= FIRST_WORKING_ROW Then
sheetObject.Visible = xlSheetVisible
Else
sheetObject.Visible = xlSheetHidden
End If

peut être remplacé par l’utilisation de iif par
sheetObject.Visible = IIf(errorSheet.Cells(Rows.Count, 1).End(xlUp).row >= FIRST_WORKING_ROW, xlSheetVisible, xlSheetHidden)

attention au déclaration de variable : strParamFlag As Boolean
Implicitement dans le code cela laisse à penser que c’est un string alors qu’il est déclaré boolean et le code serait plus clair en précisant que la valeur vaut true dans la condition

image
image1378×370 35.4 KB

image
image1378×469 42 KB

Sinon pour le reste :+1: :clap:

image
image1932×1066 180 KB

image
image1932×1023 78.9 KB

utilise pour les ouverture de fichier ma méthode avec freefile comme dans mon exemple
par exemple dans un de tes sub (doublon sur startText)
Sub GetRequestsList()
Dim mainFileName As String, filePath As String, fileData As String, startOfText As Integer, endOfText As Integer, apiText As String, apiItem() As String
Dim startText As String, startApiOffset As Integer, apiPath As String, apiPathEnd As Integer, apiList As String, i As Integer, z As String
mainFileName = Dir(ActiveWorkbook.Path & « \Main.ce*.js »)
If mainFileName = «  » Then Exit Sub
filePath = ActiveWorkbook.Path & « " & mainFileName
startText = «  »« GET » », «  »/api/"
startText = «  »« /api/ »
startApiOffset = Len(startText)
Open filePath For Input As #2
Do While Not EOF(2)
Line Input #2, fileData

il vaut mieux utiliser
Dim lFile As Long
lFile = FreeFile
Open filePath For Input As lFile
…
etc
l’utilisation de freefile évite d’utiliser un numéro de fichier qui pourrait avoir été ouvert ailleurs dans le code

Comme je suis un gros fainéant je prend une sub au hasard du module Module_IpxConfig qui a une variable i et je demande à ChatGPT la requête suivante

requete chatGPT

remplace dans le code suivant la variable i par ii et commente le code : Sub ConnectedsGroupsEndProcessing_groupeConnected(groupObject As cIpx5_Group)
'Détecte si le groupObject contient des variables connectées. Si c’est le cas, le groupe est déclaré connecté
Dim i As Integer, variableKey() As String, variableObject As cIpx5_Variable, pairObject As cIpx5_jsonPair
If groupObject.connected Then Exit Sub
For Each pairObject In groupObject.collecVariables
If Right(pairObject.name, 1) = « . » Then
If Mid(pairObject.name, Len(pairObject.name) - 4, 1) = « _ » Then 'si la variable est partagée (share ou tag)
groupObject.connected = True
Exit Sub
End If
End If
ExtractFromList pairObject.value, variableKey()
For i = 0 To UBound(variableKey)
If Contains(collecVariable, variableKey(i)) Then
Set variableObject = collecVariable(variableKey(i))
If variableObject.connected Then
groupObject.connected = True
Exit Sub
End If
End If
Next i
Next
End Sub

Le résultat

ConnectedsGroupsEndProcessing_groupeConnected chatgpt

Sub ConnectedsGroupsEndProcessing_groupeConnected(groupObject As cIpx5_Group)
’ Cette procédure détecte si le groupObject contient des variables connectées.
’ Si c’est le cas, le groupe est déclaré connecté.

Dim ii As Integer, variableKey() As String, variableObject As cIpx5_Variable, pairObject As cIpx5_jsonPair
' Vérifie si le groupe est déjà connecté, et si oui, quitte la procédure
If groupObject.connected Then Exit Sub

' Parcourt toutes les variables de collection associées au groupe
For Each pairObject In groupObject.collecVariables
    ' Vérifie si le nom de la variable se termine par un point
    If Right(pairObject.name, 1) = "." Then
        ' Vérifie si la variable est partagée (nom contenant un underscore à une position spécifique)
        If Mid(pairObject.name, Len(pairObject.name) - 4, 1) = "_" Then
            ' Si oui, marque le groupe comme connecté et quitte
            groupObject.connected = True
            Exit Sub
        End If
    End If
    
    ' Extrait les clés de la variable et les place dans un tableau variableKey
    ExtractFromList pairObject.value, variableKey()
    
    ' Parcourt les clés extraites
    For ii = 0 To UBound(variableKey)
        ' Vérifie si la clé est présente dans collecVariable
        If Contains(collecVariable, variableKey(ii)) Then
            ' Récupère l'objet variable correspondant
            Set variableObject = collecVariable(variableKey(ii))
            
            ' Si cette variable est connectée, marque le groupe comme connecté et quitte
            If variableObject.connected Then
                groupObject.connected = True
                Exit Sub
            End If
        End If
    Next ii
Next

End Sub

Bluffant faut juste vérifier mais le temps gagné on peut le passer à faire autre chose ! :slight_smile:

J’ai pas encore parcouru tout le code, je vais le faire mais quel boulot de dingue réalisé ! :exploding_head:

Ca troue le cul de savoir que Microsoft ne soit pas capable de sortir des compilateurs sur les 2 pate forme qui soient compatibles ! :thinking:
Sous Mac sinon il reste la solution d’utiliser un émulateur windows pour y faire tourner excel dedans ! :wink:

2 « J'aime »