Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Procédure trop grande VBA

  • Initiateur de la discussion Initiateur de la discussion Edd93
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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 ?
 
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
 
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
    223.2 KB · Affichages: 34
...
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:
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
 
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

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…