Procédure trop grande VBA

Edd93

XLDnaute Occasionnel
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 ?
 

Hieu

XLDnaute Impliqué
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 :
VB:
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 :
VB:
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 :
VB:
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

XLDnaute Occasionnel
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
 

Pièces jointes

  • Pb.png
    Pb.png
    223.2 KB · Affichages: 30

Hieu

XLDnaute Impliqué
...
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
 
Dernière édition:

Hieu

XLDnaute Impliqué
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 :
VB:
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

XLDnaute Occasionnel
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
 

Pièces jointes

  • Modélisation Excel qui marche.xlsm
    57.5 KB · Affichages: 21
  • Modélisation Excel PRINC - bêta.xlsm
    37.6 KB · Affichages: 20

Hieu

XLDnaute Impliqué
Essaie comme ça pour la procédure principale:
VB:
Sub flux()

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

MsgBox (lgtot)
End Sub

Et la subroutine :
VB:
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
 

Pièces jointes

  • Modélisation Excel PRINC - bêta_v0.xlsm
    34.1 KB · Affichages: 20

Discussions similaires

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh