Procédure trop grande VBA

[Edd93]

bonsoir !


Etant donné que j'ai beaucoup de conditions, le VBA ne veut plus s'exécuter ça affiche un message "procédure trop grande", voici un exemple de condition que j'ai à chaque fois

If cel.Value = "A135" Then
debx = portext2.Left + portext2.Width / 2
deby = portext2.Top + portext2.Height / 2
finx = porte69.Left + porte69.Width / 2
finy = porte69.Top + porte69.Height / 2
lg = Sqr(((finx - debx) / (0.8 * cel.Width)) * ((finx - debx) / (0.8 * cel.Width)) + ((finy - deby) / cel.Height) * ((finy - deby) / cel.Height))
lgtot = lgtot + lg

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, debx, deby, finx, finy).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
End If

Comment puis-je faire ?

 

[Edd93]

Voici le fichier ! en PJ

 

[Hieu]

Salut, un début de piste ; A manier à ta sauce.
J'ai remarqué de la redondance, dans ton code (?)
Peut être devrais-tu faire des subroutines.

Exemple :

Sub ValeurCellule(R As Range)    ' <--- ajouter les variables nécessaires debx, deby, etc...
Select Case R.Value
Case "A134", "A135", "A136", "A137"
debx = cel.Left + cel.Width / 2
deby = cel.Top + cel.Height / 2
finx = portext2.Left + portext2.Width / 2
finy = portext2.Top + portext2.Height / 2
lg = Sqr(((finx - debx) / (0.8 * cel.Width)) * ((finx - debx) / (0.8 * cel.Width)) + ((finy - deby) / cel.Height) * ((finy - deby) / cel.Height))
lgtot = lgtot + lg

 ActiveSheet.Shapes.AddConnector(msoConnectorStraight, debx, deby, finx, finy).Select
 Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen

debx = portext2.Left + portext2.Width / 2
deby = portext2.Top + portext2.Height / 2
finx = porte69.Left + porte69.Width / 2
finy = porte69.Top + porte69.Height / 2
lg = Sqr(((finx - debx) / (0.8 * cel.Width)) * ((finx - debx) / (0.8 * cel.Width)) + ((finy - deby) / cel.Height) * ((finy - deby) / cel.Height))
lgtot = lgtot + lg

 ActiveSheet.Shapes.AddConnector(msoConnectorStraight, debx, deby, finx, finy).Select
 Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
End Select
End Sub

Et du coup, la macro principale ressemblerait à ça :

Sub flux()
Set porte119 = Range("B36")
Set porte120 = Range("B41")
...
For Each cel In Range(x)
call ValeurCellule(cel) 
next cel
MsgBox (lgtot)
End Sub

Ou encore :

Sub flux()
Set porte119 = Range("B36")
Set porte120 = Range("B41")
...
For Each cel In Range(x)
select case cel.value
    case "A1"
          call titi1(cel) 
    case "A2"
          call titi2(cel)
...
end select
Next cel
MsgBox (lgtot)
End Sub

 

[Edd93]

Bonjour Hieuu, ça ne marche pas ils surlignent la ligne " Call valeurcelluleA " et disent " erreur de compilation argument non facultative " .


J'ai mis une image de ce que j'ai écris en piece jointe

 

[Hieu]

...
Poste plutot ton fichier, stp, avec une image, j'peux pas faire grand chose...
De ce que je vois, il te manque des arguments dans ta subroutine ??
Qui est debx ? deby ? finx ? finy ? porte77 ?

Lorsque tu démarres une subroutine, le programme démarre avec toutes tes variables "vierges" sauf si tu les as appelé, comme j'ai fait avec R.

Edit : J'viens de comprendre que tu n'as pas besoin de debx, deby, finx, finy, dans ta procédure principale. Te manque juste ton set

 

[Hieu]

Sur ton image, tu parles de cel (Qui est-ce ?)
On parle de R dans la subroutine... (ok, ça semble pas tres malin, sur le coup, mais il est préférable d'avoir des noms differents dans le subroutine + te faut ajouter le set :

Dans l'idée :

Sub valeurCelluleA(R As Range)
Set porteext2 = Range("CF37")
Select Case R.Value
Case "A1"
debx = R.Left + R.Width / 2
deby = R.Top + R.Height / 2
finx = porteext2.Left + porteext2.Width / 2
finy = porteext2.Top + porteext2.Height / 2
lg = Sqr(((finx - debx) / (0.8 * R.Width)) * ((finx - debx) / (0.8 * R.Width)) + ((finy - deby) / R.Height) * ((finy - deby) / R.Height))
lgtot = lgtot + lg

Call Affichage(debx, deby, finx, finy)
End Sub

Sub Affichage(debx, deby, finx, finy)
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, debx, deby, finx, finy).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
End Sub

 

[Edd93]

Voilà les fichiers, je t'ai mis la version bêta que je dois modifier en fonction de ce que tu me dis car la procédure serait trop grande sinon, et la version que j'avais qui marche actuellement

 

[Hieu]

Essaie comme ça pour la procédure principale:

Sub flux()

Set porte119 = Range("B36")
...
For Each cel In Selection
    Call valeurcelluleA(cel, lgtot)
Next cel

MsgBox (lgtot)
End Sub

Et la subroutine :

Sub valeurcelluleA(R, lgtot)
Set porte77 = Range("CN36")
Select Case R.Value
    Case "A1"
    debx = R.Left + R.Width / 2
    deby = R.Top + R.heigh / 2
   
    finx = porte77.Left + porte77.Width / 2
    finy = porte77.Top + porte77.Height / 2
   
    lg = Sqr(((finx - debx) / (0.8 * cel.Width)) * ((finx - debx) / (0.8 * cel.Width)) + ((finy - deby) / cel.Height) * ((finy - deby) / cel.Height))
    lgtot = lgtot + lg
   
    Call affichage(debx, deby, finx, finy)
    End Select
End Sub
Sub affichage(debx, deby, finx, finy)
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, debx, deby, finx, finy).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen

End Sub

 

[Edd93]

ça marche, j'espère que quand je rajouterai les autres cellules ça marchera aussi