Macro protégée - travail impossible

Bonjour,

Je reprend le travail d'un précédant stagiaire sur un classeur de dimensionnement mécanique complexe et blindé de vba comme d'hab.

J'essaie pour le moment de comprendre comment ce classeur fonctionne et je tente de décrypter le code qui est incroyablement long et complexe (bien sûr aucune explication n'est fournies et personne pour m'aider ... ).

J'ai deux macro additionnelles ainsi qu'un Add-on qui sont protégés via mot de passe, bien entendu le stagiaire n'a pas fourni le mot de passe afin de protéger ses lignes adorées (oui une macro s'appelle "morefun" pour vous dire que ça l'amuse en plus).

En bref j'ai essayé de cracker le code en bidouillant à la racine de l'excel via un compilateur hexadécimal mais je n'arrive toujours pas à accéder à l'onglet "protection" des propriétés de la macro car ce foutu mot de passe est encore là même après le bidouillage.

En bref je suis cuit si j'ai pas ce mot de passe et je vais au pire devoir refaire un Excel complet avec tout ce que cela implique comme temps perdu.

Quelqu'un a une technique ou suis-je irrémédiablement foutu ?

phurba.

Le compilateur hexadécimal, cela marchait jusqu'à la version 2003 d'Excel. A partir de Office 2007, tout est crypté.

Donc je dirai que vous êtes effectivement (et malheureusement) cuit, comme vous dites.

Par contre, je le prendrai de l'autre côté: pourquoi ne pas prendre le contact avec le stagiaire et lui demamder le mot de passe?

Votre patron ou les RH doivent avoir ses coordonnées. Et s'il refuse, vous lui rappelez que tout travail crée pendant les heures de travail appartient à l'employeur et que l'entreprise n'hésitera pas à lui envoyer une mise en demeure...

Bonjour,

Pour ma part, j'éviterai juste le passage de la mise en demeure proposé par Excel-Malin ... S'il refuse vous êtes cuit point final.

Si vraiment il ne veut pas vous fournir le mot de passe, face à une mise en demeure il pourra simplement prôner l'oubli du mot de passe jadis utilisé et botter en touche sans le moindre problème.

Cordialement,

Ok je vais voir s'il est possible de le contacter, y'a intérêt.

Merci bien les gens et bonne journée.

PS: le compilateur est censé fonctionner sur une version 2010, en effet il a modifié l'Excel mais pas l'accès au mot de passe, bref.

bonjour,

Apparemment vous avez accès au VBA de ce classeur puisque vous tentez de décrypter ce code.

concernant "morefun" il ne s'agit vraisemblablement pas d'une production de ce stagiaire, mais d'une macro complémentaire de Laurent LONGRE appelée en réalité MOREFUNC.

MOREFUNC est depuis longtemps éprouvé (et approuvé...) par la communauté Excel vous pouvez donc conserver cette macro complémentaire comme faisant partie intégrante d'Excel et en valider les macros qui y font appel "les yeux fermés."

Pour le nettoyage du code vous pouvez éventuellement nous communiquer le VBA du classeur pour essayer d'y mettre un peu d'ordre...

A+

Hum hum je vois en effet c'est bien le nom d'une des macros du classeur, je vais tenter de voir ce qu'elle fait.

Par contre c'est une autre macro qui est verrouillées, nom Solver, là je pense que c'est une macro perso par contre.

EDIT: Alors en réalité le code verrouillé est le SOLVEUR appelé "complément solveur" et apparemment c'est un add-in d'Excel couramment utilisé, du coup je pense que je vais me pencher sur son fonctionnement.

Très peu probable que Solver soit de lui

Il m'a l'air d'un bon geek quand même au vue du code qu'il a écrit déjà mais bon là je pense que si c'est de lui je fais pas le poids, mais alors pas du tout !

Pour un avis ou/et le nettoyage du code et avoir des explications ou des commentaires, vous pouvez éventuellement nous communiquer le VBA du classeur...

A+

Vous donner le code ne vous avancera pas des masses étant donné que l'excel est trop grand pour être mis en pièce jointe.

Option Explicit
Option Base 1

Sub mef_skid()

    'Variables générales pour les boucles et matrices
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer

Worksheets("Detail design").Select

'
''Definition du maillage
'

Dim nbr_poutre_trans As Integer 'Compte le nombre de poutres transverse rentrées sur la feuille
nbr_poutre_trans = WorksheetFunction.CountIf(Worksheets("Detail design").Range("G30:G34"), ">0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("J30:J34"), ">0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("M30:M34"), ">0")

Worksheets("Detail design").Range("M18").Value = "Ref " & Str(nbr_poutre_trans + 2)

Dim nbr_force As Integer 'Compte le nombre de forces rentrées sur la feuille
nbr_force = WorksheetFunction.CountIf(Worksheets("Detail design").Range("E37:M37"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E39:M39"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E41:M41"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E43:M43"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E45:M45"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E49:L49"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E51:L51"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E53:L53"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E55:L55"), ">=0") _
    + WorksheetFunction.CountIf(Worksheets("Detail design").Range("E57:L57"), ">=0")

Dim nbr_noeud As Integer 'Calcul le nombre de noeuds du maillage
nbr_noeud = 4 + 4 + nbr_poutre_trans * 2 + nbr_force

Dim nbr_element As Integer 'Calcul le nombre d element du modele
nbr_element = (nbr_poutre_trans + 2 + 1) * 2 + (nbr_force + nbr_poutre_trans + 2)

Dim poutre_trans() 'Contient le numero du premier element, dernier element, le deplacement max et la contrainte max de chaque poutre transversale
ReDim poutre_trans(nbr_poutre_trans + 2, 4)

Dim poutre()
ReDim poutre(2, nbr_poutre_trans + 3)

'
''Caractéristiques du skid
'

Dim caract_poutre_trans As Variant 'Type et emplacement de chaque poutre transverse
caract_poutre_trans = caracteristiques_poutre_trans(nbr_poutre_trans)

Dim largeur_skid As Double
largeur_skid = Worksheets("Basic design").Range("E43").Value

Dim longueur_skid As Double
longueur_skid = WorksheetFunction.Sum(Worksheets("Basic design").Range("F34:F41"))

Dim position_levage_1 As Double
position_levage_1 = Worksheets("Basic design").Range("F61").Value

Dim position_levage_2 As Double
position_levage_2 = WorksheetFunction.Sum(Worksheets("Basic design").Range("F34:F41")) _
    - Worksheets("Basic design").Range("F62").Value

Dim noeud_encours As Integer 'Numero du prochain noeud du maillage, les 4 premiers sont réservés pour la position anneau de levage
noeud_encours = 5

Dim element()
'Matrice contenant les caractéristiques de chaque element du modele EF
'poutre(i)(Noeud 1, Noeud 2, E, A, L, Iz, Iy, G, Ix, Rotation à 90°?, V)
ReDim element(nbr_element)

Dim temp_noeud_haut As Integer
Dim temp_noeud_bas As Integer

Dim anneau1 As Boolean
anneau1 = True

Dim anneau2 As Boolean
anneau2 = True

Dim temp_L As Double 'Variable temporaire calculant la longueur de la poutre du modèle
Dim position_avant As Double
position_avant = 0
Dim position_avant_2 As Double

Dim position_effort()
'Matrice contenant le noeud on s'applique les efforts et leurs intensités
ReDim position_effort(nbr_force, 2)

k = 1
l = 1
n = 1

For i = 1 To nbr_poutre_trans + 2

    'Position 1 des blocs de levage
    If caract_poutre_trans(i, 2) > position_levage_1 And anneau1 Then

        temp_L = position_levage_1 - position_avant

        element(k) = caract_poutre(temp_noeud_haut, 1, temp_L, caract_poutre_trans(1, 1), False)
        temp_noeud_haut = 1
        poutre(1, n) = k
        k = k + 1

        element(k) = caract_poutre(temp_noeud_bas, 2, temp_L, caract_poutre_trans(1, 1), False)
        temp_noeud_bas = 2
        poutre(2, n) = k
        n = n + 1
        k = k + 1

        anneau1 = False
        position_avant = position_levage_1

    End If

    'Position 2 des blocs de levage
    If caract_poutre_trans(i, 2) > position_levage_2 And anneau2 Then

        temp_L = position_levage_2 - position_avant

        element(k) = caract_poutre(temp_noeud_haut, 3, temp_L, caract_poutre_trans(1, 1), False)
        temp_noeud_haut = 3
        poutre(1, n) = k
        k = k + 1

        element(k) = caract_poutre(temp_noeud_bas, 4, temp_L, caract_poutre_trans(1, 1), False)
        temp_noeud_bas = 4
        poutre(2, n) = k
        n = n + 1
        k = k + 1

        anneau2 = False
        position_avant = position_levage_2

    End If

    If i <> 1 Then
        'Si ce n'est pas la premiere poutre transversale on rajoute le morceau de poutre de la partie longitudinale haute
        'morceau de poutre reliant 2 poutre transversale ou bloc de levage et poutre transversale

        temp_L = caract_poutre_trans(i, 2) - position_avant
        element(k) = caract_poutre(temp_noeud_haut, noeud_encours, temp_L, caract_poutre_trans(1, 1), False)
        poutre(1, n) = k
        k = k + 1

    End If

    temp_noeud_haut = noeud_encours 'On retient le dernier numero de noeud de la poutre longitudinale haute

    temp_L = 0
    position_avant_2 = 0

    poutre_trans(i, 1) = k

    For j = 0 To 8 Step 2 'On parcoure les forces renseignées sur la feuille pour la poutre transversale i

        If i < 10 Then
            m = 37
        Else
            m = 49
        End If

        If Cells(m + j, 4 + i) <> "" Then

            If Cells(m + j, 4 + i) = 0 Then
                'Cas ou la force se trouve sur la poutre longitudinale haute
                'On ne crée pas de point ou poutre, on stock juste l information de l'effort

                position_effort(l, 1) = noeud_encours
                position_effort(l, 2) = Cells(m + 1 + j, 4 + i) * -10
                l = l + 1

                nbr_noeud = nbr_noeud - 1
                nbr_element = nbr_element - 1

            ElseIf Cells(37 + j, 4 + i) = largeur_skid Then
                'Cas ou la force se trouve sur la poutre longitudinale basse
                'On ne crée pas de point ou poutre, on stock juste l information de l'effort

                position_effort(l, 1) = noeud_encours + 1
                position_effort(l, 2) = Cells(m + 1 + j, 4 + i) * -10
                l = l + 1

                nbr_noeud = nbr_noeud - 1
                nbr_element = nbr_element - 1

            Else
                'Cas ou la force se trouve quelque part sur la poutre transversale
                'On crée un nouveau point et poutre et on stock l information de l'effort

                temp_L = Cells(m + j, 4 + i) - position_avant_2
                element(k) = caract_poutre(noeud_encours, noeud_encours + 1, temp_L, caract_poutre_trans(i, 1), True)
                noeud_encours = noeud_encours + 1
                k = k + 1
                position_avant_2 = Cells(m + j, 4 + i)

                position_effort(l, 1) = noeud_encours
                position_effort(l, 2) = Cells(m + 1 + j, 4 + i) * -10
                l = l + 1

            End If

        Else

            Exit For

        End If

    Next j

    'On "ferme" la poutre transversale

    temp_L = largeur_skid - position_avant_2
    element(k) = caract_poutre(noeud_encours, noeud_encours + 1, temp_L, caract_poutre_trans(i, 1), True)
    noeud_encours = noeud_encours + 1

    poutre_trans(i, 2) = k

    k = k + 1

    If i <> 1 Then
        'Si ce n'est pas la premiere poutre transversale on rajoute le morceau de poutre de la partie longitudinale basse
        'morceau de poutre reliant 2 poutres transversales ou bloc de levage et poutre transversale

        temp_L = caract_poutre_trans(i, 2) - position_avant
        element(k) = caract_poutre(temp_noeud_bas, noeud_encours, temp_L, caract_poutre_trans(1, 1), False)
        poutre(2, n) = k
        n = n + 1
        k = k + 1

    End If

    temp_noeud_bas = noeud_encours 'On retient le dernier numero de noeud de la poutre longitudinale basse
    noeud_encours = noeud_encours + 1
    position_avant = caract_poutre_trans(i, 2)

Next i

'
''Calcul de l'ensemble des Ke (repere local)
'

Dim Ke()
ReDim Ke(nbr_element)

For i = 1 To nbr_element

    Ke(i) = rigide_element(element(i)(3), element(i)(4), element(i)(5), element(i)(6), element(i)(7), element(i)(8), element(i)(9))

Next i

'
''Calcul des Fe
'

'
''Matrice de rotation
'

    'definition de l ensemble des matrices de rotation

Dim rotation_90(12, 12)

Dim rotation_90_trans As Variant

For i = 1 To 12
    For j = 1 To 12
        rotation_90(i, j) = 0
    Next j
Next i

rotation_90(1, 3) = 1
rotation_90(2, 2) = 1
rotation_90(3, 1) = -1

rotation_90(4, 6) = 1
rotation_90(5, 5) = 1
rotation_90(6, 4) = -1

rotation_90(7, 9) = 1
rotation_90(8, 8) = 1
rotation_90(9, 7) = -1

rotation_90(10, 12) = 1
rotation_90(11, 11) = 1
rotation_90(12, 10) = -1

rotation_90_trans = WorksheetFunction.Transpose(rotation_90)

'
''Calcul des Ke dans le repere global
'

Dim temp As Variant

For i = 1 To nbr_element

    If element(i)(10) Then

        temp = Application.Run("MMULT.EXT", rotation_90_trans, Ke(i))

        Ke(i) = Empty
        Ke(i) = Application.Run("MMULT.EXT", temp, rotation_90)
        temp = Empty

    End If

Next i

'
''Calcul des Fe dans le repere global
'

'
''Assemblage de K
'

    'Definiton matrice assemblé vide

Dim K_asm_vide()
ReDim K_asm_vide(nbr_noeud * 6, nbr_noeud * 6)

For i = 1 To UBound(K_asm_vide)
    For j = 1 To UBound(K_asm_vide)

        K_asm_vide(i, j) = 0

    Next j
Next i

    'Ajout de la contribution de chaque Ke à la matrice assemblée

Dim K_asm_temp(2)

K_asm_temp(1) = K_asm_vide

For i = 1 To nbr_element

    K_asm_temp(2) = assemblage_K(K_asm_temp(1), element(i)(1), element(i)(2), Ke(i))

    K_asm_temp(1) = Empty
    K_asm_temp(1) = K_asm_temp(2)

Next i

Dim K_asm As Variant

K_asm = K_asm_temp(1)

'
''Conditions aux limites
'

    'au final tableau comprenant les lignes et colonnes à supprimer
Dim condi_limite As Variant

condi_limite = Array(1, 2, 3, 7, 8, 9, 13, 14, 15, 19, 20, 21)

    'reduction de la matrice K
Dim K_asm_reduit As Variant

K_asm_reduit = reduction_K(K_asm, condi_limite)

'
''Resolution du systeme KU=F
'

    'Inversion de K
Dim K_asm_inv As Variant

K_asm_inv = Application.Run("MINVERSE.EXT", K_asm_reduit)

Dim K_asm_inv_2 As Variant

K_asm_inv_2 = InverseMatrice(K_asm_reduit)

    'Definition de F
Dim F() As Variant
ReDim F(UBound(K_asm_reduit, 1), 1)

For i = 1 To UBound(F)
    F(i, 1) = 0
Next i

For l = 1 To nbr_force
    i = position_effort(l, 1) * 6 - 4 - 3 * 4
    F(i, 1) = position_effort(l, 2)
Next l

    'K*F
Dim U_reduit As Variant
U_reduit = Application.Run("MMULT.EXT", K_asm_inv, F)

Dim U_reduit_2 As Variant
U_reduit_2 = resolutionGaussJordan(K_asm_reduit, F)

Dim U_reduit_3 As Variant
U_reduit_3 = Application.Run("MMULT.EXT", K_asm_inv_2, F)

Dim U_reduit_4 As Variant
'U_reduit_4 = RunSolver(K_asm_reduit, F)

Dim U_choisi As Variant
U_choisi = U_reduit_2

    'Réaction aux appuis
Dim U()
ReDim U(nbr_noeud * 6, 1)

j = 1

For i = 1 To 19 Step 6
    U(i, 1) = 0
    U(i + 1, 1) = 0
    U(i + 2, 1) = 0

    U(i + 3, 1) = U_choisi(j, 1)
    U(i + 4, 1) = U_choisi(j + 1, 1)
    U(i + 5, 1) = U_choisi(j + 2, 1)

    j = j + 3
Next i

For i = 25 To UBound(U)
    U(i, 1) = U_choisi(i - 12, 1)
Next i

Dim reactions_appuis As Variant
reactions_appuis = Application.Run("MMULT.EXT", K_asm, U)

    'Effort dans les elements
Dim effort_poutre() As Variant
ReDim effort_poutre(nbr_element)

Dim temp_U(12, 1)
Dim temp_U_2 As Variant

For i = 1 To nbr_element
    j = element(i)(1) * 6
    temp_U(1, 1) = U(j - 5, 1)
    temp_U(2, 1) = U(j - 4, 1)
    temp_U(3, 1) = U(j - 3, 1)
    temp_U(4, 1) = U(j - 2, 1)
    temp_U(5, 1) = U(j - 1, 1)
    temp_U(6, 1) = U(j, 1)

    j = element(i)(2) * 6
    temp_U(7, 1) = U(j - 5, 1)
    temp_U(8, 1) = U(j - 4, 1)
    temp_U(9, 1) = U(j - 3, 1)
    temp_U(10, 1) = U(j - 2, 1)
    temp_U(11, 1) = U(j - 1, 1)
    temp_U(12, 1) = U(j, 1)

    If element(i)(10) Then
        temp_U_2 = Application.Run("MMULT.EXT", rotation_90, temp_U)
        effort_poutre(i) = Application.Run("MMULT.EXT", Application.Run("MMULT.EXT", Application.Run("MMULT.EXT", rotation_90, Ke(i)), rotation_90_trans), temp_U_2)
    Else
        effort_poutre(i) = Application.Run("MMULT.EXT", Ke(i), temp_U)
    End If

Next i

    'Calcul contrainte max de chaque poutre transversale du skid
Dim max
For i = 1 To UBound(poutre_trans)
    max = 0
    For j = poutre_trans(i, 1) To poutre_trans(i, 2)
        temp = effort_poutre(j)(6, 1) / element(j)(6) * element(j)(11)

        If Abs(temp) > Abs(max) Then
            max = temp
        End If

        temp = effort_poutre(j)(12, 1) / element(j)(6) * element(j)(11)

        If Abs(temp) > Abs(max) Then
            max = temp
        End If
    Next j

    poutre_trans(i, 4) = max
    Worksheets("Detail design").Range("T" & 16 + i).Value = Abs(max)
Next i

    'Calcul contrainte max des deux poutres longitudianles du skid
For i = 1 To 2
    max = 0
    For j = 1 To nbr_poutre_trans + 3
        k = poutre(i, j)
        temp = effort_poutre(k)(6, 1) / element(k)(6) * element(k)(11)

        If Abs(temp) > Abs(max) Then
            max = temp
        End If

        temp = effort_poutre(k)(12, 1) / element(k)(6) * element(k)(11)

        If Abs(temp) > Abs(max) Then
            max = temp
        End If
    Next j

    poutre_trans(i, 4) = max
    Worksheets("Detail design").Range("T" & 9 + i * 2).Value = Abs(max)
Next i

    'Calcul déplacement max de chaque poutre transversale du skid
Dim varr
Dim vara
Dim varb
Dim varc
Dim vard
For i = 1 To UBound(poutre_trans)
    k = element(poutre_trans(i, 1))(1)
    l = element(poutre_trans(i, 2))(2)
    Worksheets("RunSolveur2").Range("B6:B30").Value = ""
    Worksheets("RunSolveur2").Range("D6:D30").Value = ""

    m = 1
    For j = k To l

        Worksheets("RunSolveur2").Range("B" & 5 + m).Value = U(j * 6 - 4, 1)

        If m = 1 Then
            Worksheets("RunSolveur2").Range("D" & 5 + m).Value = 0
        Else
            Worksheets("RunSolveur2").Range("D" & 5 + m).Value = element(m - 1)(5) + Worksheets("RunSolveur2").Range("D" & 4 + m).Value
        End If

        m = m + 1

    Next j

    varr = Application.LinEst(Worksheets("RunSolveur2").Range("B6:B" & 5 + m - 1), Application.Power(Worksheets("RunSolveur2").Range("D6:D" & 5 + m - 1), Array(1, 2)), True, 0)
    vara = Application.Index(varr, 1)
    varb = Application.Index(varr, 2)
    varc = Application.Index(varr, 3)
    'vard = Application.Index(varr, 4)
    Worksheets("RunSolveur2").Range("H6").Value = "=" & Str(vara) & "*F6^2+" & Str(varb) & "*F6+" & Str(varc)

    Worksheets("RunSolveur2").Select
    ' reset
    Application.Run "SolverReset"

    Application.Run "SolveurOptions", , , 0.00001, True, , , , , , , , False

    ' set up new analysis
    Application.Run "SolverOk", "$H$6", 2, , "$F$6", , "GRG Nonlinear"

    ' add constraints
    Application.Run "SolverAdd", "$F$6", 3, "$D$6"
    Application.Run "SolverAdd", "$F$6", 1, "$D$" & (5 + m - 1)

    Dim result As Integer

    ' run the analysis
    Application.Run "SolverSolve", True

    ' finish the analysis
    Application.Run "SolverFinish"

    Worksheets("Detail design").Select
    Worksheets("Detail design").Range("V" & 16 + i).Value = Worksheets("RunSolveur2").Range("H6").Value

Next i

    'Calcul déplacement max des deux poutres longitudinale du skid
For i = 1 To 2
    'k = element(poutre_trans(i, 1))(1)
    'l = element(poutre_trans(i, 2))(2)
    'Worksheets("RunSolveur2").Range("B6:B30").Value = ""
    'Worksheets("RunSolveur2").Range("D6:D30").Value = ""

    m = 1
    For j = 1 To UBound(poutre, 2)
        k = poutre(i, j)
        If m = 1 Then
            l = element(k)(1)
            Worksheets("RunSolveur2").Range("B" & 5 + m).Value = U(l * 6 - 4, 1)
            Worksheets("RunSolveur2").Range("D" & 5 + m).Value = 0
            m = m + 1
        End If

        l = element(k)(2)
        Worksheets("RunSolveur2").Range("B" & 5 + m).Value = U(l * 6 - 4, 1)
        Worksheets("RunSolveur2").Range("D" & 5 + m).Value = element(k)(5) + Worksheets("RunSolveur2").Range("D" & 4 + m).Value

        m = m + 1

    Next j

    varr = Application.LinEst(Worksheets("RunSolveur2").Range("B6:B" & 5 + m - 1), Application.Power(Worksheets("RunSolveur2").Range("D6:D" & 5 + m - 1), Array(1, 2, 3)), True, 0)
    vara = Application.Index(varr, 1)
    varb = Application.Index(varr, 2)
    varc = Application.Index(varr, 3)
    vard = Application.Index(varr, 4)
    Worksheets("RunSolveur2").Range("H6").Value = "=" & Str(vara) & "*F6^3+" & Str(varb) & "*F6^2+" & Str(varc) & "*F6+" & Str(vard)

    Worksheets("RunSolveur2").Select
    ' reset
    Application.Run "SolverReset"

    Application.Run "SolveurOptions", , , 0.00001, True, , , , , , , , False

    ' set up new analysis
    Application.Run "SolverOk", "$H$6", 2, , "$F$6", , "GRG Nonlinear"

    ' add constraints
    Application.Run "SolverAdd", "$F$6", 3, "$D$6"
    Application.Run "SolverAdd", "$F$6", 1, "$D$" & (5 + m - 1)

    ' run the analysis
    Application.Run "SolverSolve", True

    ' finish the analysis
    Application.Run "SolverFinish"

    Worksheets("Detail design").Select
    Worksheets("Detail design").Range("X" & 9 + i * 2).Value = Worksheets("RunSolveur2").Range("H6").Value

Next i

'Affichage pour verifications

Worksheets("Feuil2").Range("D3:D104").Value = U_reduit

Worksheets("Feuil2").Range("F3:F104").Value = U_reduit_2

Worksheets("Feuil2").Range("H3:H104").Value = U_reduit_3

Worksheets("Feuil2").Range("J3:J104").Value = F

Worksheets("Feuil2").Range("M3:M116").Value = reactions_appuis

l = 2

For i = 1 To nbr_element
    For j = 1 To 6
        Worksheets("Feuil2").Cells(l + j, 16).Value = effort_poutre(i)(j, 1) * -1
    Next j
    For j = 7 To 12
        Worksheets("Feuil2").Cells(l + j, 16).Value = effort_poutre(i)(j, 1)
    Next j

    l = l + 13
Next i

End Sub

Function caracteristiques_poutre_trans(nbr_poutre_trans)

Dim i As Integer
Dim k As Integer

Dim caract()
ReDim caract(nbr_poutre_trans + 2, 2)

caract(1, 1) = "UPE " & CStr(Worksheets("Basic design").Range("F45").Value)
caract(1, 2) = 0

k = 2

For i = 30 To 34

    If Cells(i, 6) <> 0 Then

        caract(k, 1) = CStr(Worksheets("Detail design").Range("F" & i).Value)
        caract(k, 2) = Worksheets("Detail design").Range("G" & i).Value

        k = k + 1

    Else: Exit For

    End If

Next i

For i = 30 To 34

    If Cells(i, 9) <> 0 Then

        caract(k, 1) = CStr(Worksheets("Detail design").Range("I" & i).Value)
        caract(k, 2) = Worksheets("Detail design").Range("J" & i).Value

        k = k + 1

    Else: Exit For

    End If

Next i

For i = 30 To 34

    If Cells(i, 12) <> 0 Then

        caract(k, 1) = CStr(Worksheets("Detail design").Range("L" & i).Value)
        caract(k, 2) = Worksheets("Detail design").Range("M" & i).Value

        k = k + 1

    Else: Exit For

    End If

Next i

caract(nbr_poutre_trans + 2, 1) = "UPE " & CStr(Worksheets("Basic design").Range("F45").Value)
caract(nbr_poutre_trans + 2, 2) = WorksheetFunction.Sum(Worksheets("Basic design").Range("F34:F41"))

caracteristiques_poutre_trans = caract

End Function

Function caract_poutre(noeud1, noeud2, longueur, type_poutre, rotation)

'element(i)(Noeud 1, Noeud 2, E, A, L, Iz, Iy, G, Ix)

Dim toto(11)

Dim A As Double, Iz As Double, Iy As Double, Ix As Double

A = WorksheetFunction.VLookup(type_poutre, Worksheets("biblio poutres").Range("B6:G65"), 2, False)
Iz = WorksheetFunction.VLookup(type_poutre, Worksheets("biblio poutres").Range("B6:G65"), 3, False)
Iy = WorksheetFunction.VLookup(type_poutre, Worksheets("biblio poutres").Range("B6:G65"), 4, False)
Ix = WorksheetFunction.VLookup(type_poutre, Worksheets("biblio poutres").Range("B6:G65"), 5, False)

toto(1) = noeud1
toto(2) = noeud2
toto(3) = Worksheets("Basic design").Range("F50").Value
toto(4) = A
toto(5) = longueur
toto(6) = Iz
toto(7) = Iy
toto(8) = toto(3) / (2 * (1 + Worksheets("Basic design").Range("F51").Value))
toto(9) = Ix
toto(10) = rotation

toto(11) = WorksheetFunction.VLookup(type_poutre, Worksheets("biblio poutres").Range("B6:G65"), 6, False)

caract_poutre = toto

End Function

Function rigide_element(E, A, l, Iz, Iy, G, Ix)
'
''Calcul de la matrice du rigidé d une poutre dans son repere local
''en fonction de ces variables
'

    'Variables générales pour les boucles et matrices
Dim i As Integer
Dim j As Integer

    'Creation de la matrice Ke vide
Dim Ke(12, 12)

For i = 1 To 12
    For j = 1 To 12

        Ke(i, j) = 0

    Next j
Next i

    'Calcul cellule Ke non nulle (d'apres matrice connue)
Ke(1, 1) = E * A / l
Ke(1, 7) = -E * A / l

Ke(2, 2) = 12 * E * Iz / l ^ 3
Ke(2, 6) = 6 * E * Iz / l ^ 2
Ke(2, 8) = -12 * E * Iz / l ^ 3
Ke(2, 12) = 6 * E * Iz / l ^ 2

Ke(3, 3) = 12 * E * Iy / l ^ 3
Ke(3, 5) = -6 * E * Iy / l ^ 2
Ke(3, 9) = -12 * E * Iy / l ^ 3
Ke(3, 11) = -6 * E * Iy / l ^ 2

Ke(4, 4) = G * Ix / l
Ke(4, 10) = -G * Ix / l

Ke(5, 3) = -6 * E * Iy / l ^ 2
Ke(5, 5) = 4 * E * Iy / l
Ke(5, 9) = 6 * E * Iy / l ^ 2
Ke(5, 11) = 2 * E * Iy / l

Ke(6, 2) = 6 * E * Iz / l ^ 2
Ke(6, 6) = 4 * E * Iz / l
Ke(6, 8) = -6 * E * Iz / l ^ 2
Ke(6, 12) = 2 * E * Iz / l

Ke(7, 1) = -E * A / l
Ke(7, 7) = E * A / l

Ke(8, 2) = -12 * E * Iz / l ^ 3
Ke(8, 6) = -6 * E * Iz / l ^ 2
Ke(8, 8) = 12 * E * Iz / l ^ 3
Ke(8, 12) = -6 * E * Iz / l ^ 2

Ke(9, 3) = -12 * E * Iy / l ^ 3
Ke(9, 5) = 6 * E * Iy / l ^ 2
Ke(9, 9) = 12 * E * Iy / l ^ 3
Ke(9, 11) = 6 * E * Iy / l ^ 2

Ke(10, 4) = -G * Ix / l
Ke(10, 10) = G * Ix / l

Ke(11, 3) = -6 * E * Iy / l ^ 2
Ke(11, 5) = 2 * E * Iy / l
Ke(11, 9) = 6 * E * Iy / l ^ 2
Ke(11, 11) = 4 * E * Iy / l

Ke(12, 2) = 6 * E * Iz / l ^ 2
Ke(12, 6) = 2 * E * Iz / l
Ke(12, 8) = -6 * E * Iz / l ^ 2
Ke(12, 12) = 4 * E * Iz / l

rigide_element = Ke

End Function

Function assemblage_K(K_asm, noeud_1, noeud_2, Ke_global)
'
''Ajout contribution de la matrice ke dans le repere global (Ke_global) d une poutre
''en fonction de ces noeuds (noeud_1, noeud_2) à la matrice K assemblée (K_asm)
'

    'Variables générales pour les boucles et matrices
Dim i As Integer
Dim j As Integer

    'Definition numero colone et ligne affecté par l element
Dim A, B, C As Integer

A = 1 + (noeud_1 - 1) * 6

B = 1 + (noeud_2 - 1) * 6
C = B - 6

    'Carre haut gauche

For i = A To A + 5
    For j = A To A + 5

        K_asm(i, j) = K_asm(i, j) + Ke_global(1 + i - A, 1 + j - A)

    Next j
Next i

    'Carre bas droite

For i = B To B + 5
    For j = B To B + 5

        K_asm(i, j) = K_asm(i, j) + Ke_global(1 + i - C, 1 + j - C)

    Next j
Next i

    'Carre haut droit

For i = A To A + 5
    For j = B To B + 5

        K_asm(i, j) = K_asm(i, j) + Ke_global(1 + i - A, 1 + j - C)

    Next j
Next i

    'Carre bas gauche

For i = B To B + 5
    For j = A To A + 5

        K_asm(i, j) = K_asm(i, j) + Ke_global(1 + i - C, 1 + j - A)

    Next j
Next i

    'Return de la matrice assemblée

assemblage_K = K_asm

End Function

Function reduction_K(K_asm, vValeur)

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

Dim reduc() As Variant
ReDim reduc(UBound(K_asm, 1) - UBound(vValeur), UBound(K_asm, 2) - UBound(vValeur))

k = 1
For i = 1 To UBound(K_asm, 1)
    If fIsIn(i, vValeur) Then
    l = 1
    For j = 1 To UBound(K_asm, 2)
        If fIsIn(j, vValeur) Then
        reduc(k, l) = K_asm(i, j)
        l = l + 1
        End If
    Next j
    k = k + 1
    End If
Next i

reduction_K = reduc

End Function

Function fIsIn(ByVal vValeur As Variant, ByVal vArray As Variant) As Boolean
'Verifie qu un element (vValeur) n est pas dans la liste (vArray)

Dim v As Variant

For Each v In vArray
    If v = vValeur Then Exit For
Next v

fIsIn = IIf(IsEmpty(v), True, False)

End Function

Vous ai-je déjà mentionné être un newbie en vba, tout nouveau pour moi bien que j'y vois maintenant un peu plus claire ...

et ça ça contrôle alors le solveur mais je cherche encore comment ça fonctionne tout ça ...

Function RunSolver(k, F)

Dim i, j As Integer

Worksheets("RunSolveur").Select

Dim n As Integer

n = UBound(k)

Dim temp As String

For i = 1 To n
    temp = "="
    For j = 1 To n

        Cells(5 + i, 7 + j) = k(i, j)

        temp = temp + "+" & Cells(5 + i, 7 + j).Address & "*" & "D" & CStr(5 + j)
    Next j

    Range("B" & 5 + i).Formula = temp

    Range("D" & 5 + i).Formula = 1

    Range("F" & 5 + i).Formula = F(i, 1)
Next i

' reset
Application.Run "SolverReset"

Application.Run "SolveurOptions", , , 0.00001, True, , , , , , , , False

' set up new analysis
Application.Run "SolverOk", , , , "$D$6:$D$" & CStr(5 + n), , "GRG Nonlinear"

' add constraints
Application.Run "SolverAdd", "$B$6:$B$" & CStr(5 + n), 2, "$F$6:$F$" & CStr(5 + n)

Dim result As Integer

' run the analysis
result = Application.Run("SolverSolve", True)

' finish the analysis
Application.Run "SolverFinish"

' report on success of analysis
If result <= 3 Then
  ' Result = 0, Solution found, optimality and constraints satisfied
  ' Result = 1, Converged, constraints satisfied
  ' Result = 2, Cannot improve, constraints satisfied
  ' Result = 3, Stopped at maximum iterations
  MsgBox "Solver found a solution", vbInformation, "SOLUTION FOUND"
Else
  ' Result = 4, Solver did not converge
  ' Result = 5, No feasible solution
  Beep
  MsgBox "Solver was unable to find a solution.", vbExclamation, "SOLUTION NOT FOUND"
End If

RunSolver = Range("D6:D" & 5 + n).Value

End Function

Oui,

C'était juste une suggestion. On peut juste confirmer que ce code est plutôt propre.

A première vue, rien de trivial, ni d'incongru. ça se déroule comme un roman !

Juste à entretenir... Bon courage !

A+