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

XL 2010 Procédure trop longue VBA - formulaire

J

jptaz15

XLDnaute Nouveau
Bonjour à tous, je suis nouveau sur VBA et j'ai une petite problématique . J'ai créé un formulaire avec de nombreuses textbox, toutes reliées à une colonne dans une base de données. Lorsque j'ouvre un nouveau formulaire et que je sauvegarde, les données sont insérées dans les bonnes colonnes et tout se passe bien. J'ai ensuite un bouton "modifier" qui doit servir à replacer les bonnes valeurs dans les bonnes textbox selon le nom du client pour ensuite modifier ou ajouter. Or, la procédure fonctionne très bien avec quelques lignes de code, mais lorsque mon code est entré au complet (610 colonnes), j'obtiens l'erreur suivante "procédure trop longue".

N'étant pas un pro en VBA, je ne sais pas trop quoi faire. J'imagine qu'il doit y avoir une façon de réduire significativement le code. Puis-je fractionner une partie du code et utiliser la fonction "call" (j'ai essayé mais cela ne semble pas fonctionner de la manière dont je l'écris).

Pour votre information, je me suis inspiré du formulaire suivant de "Tiger Spreadsheet Solutions"

En espérant que je sois assez clair.

merci d'avance

Jean-Philippe
 

Pièces jointes

  • Formulaire éval 1.xlsm
    206.1 KB · Affichages: 28
Dernière édition:
Solution
Bonsoir à tous,
j'ai changé d'approche, supprimé l'éclatement en 2 sub, je n'ai gardé que remplir1 (qui contient tous les cas).
je lui ai fait subir une cure d'amaigrissement pour ne pas dépasser les 64k.
ex :
Dim SD
Set SD = Sheets("Data")
Dim W
Set W = Data_UF
moins de texte implique moins de poids
ça fonctionne (fichier joint).
Trier par date Trier par votes

MP59

XLDnaute Occasionnel
Bonjour,
"Lorsqu’il est compilé, le code d’une procédure ne peut pas dépasser 64K. Fractionnez-le, ainsi que les éventuelles autres grandes procédures, en plusieurs procédures plus petites."

voir essai ci-joint avec ta procédure trop longue coupée en 2:
remplir1
remplir2
 

Pièces jointes

  • Formulaire éval 1Vmp59.xlsm
    162.4 KB · Affichages: 6
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Bonjour Jean-Philippe
Bonjour MP59
ou avec des procédures ramenées à :
Perfectibles
VB: 
Dim StrSearch$
'protocole adapté
Private Sub Combo_prot_ini_Change()
With usf
    With .Combo_prot_ini
       StrSearch = .Text
    End With
    For i = 1 To 16
        With .Controls("Text_vit" & i & "_ini")
             .Enabled = IIf(StrSeach = "Protocole adapté", True, False)
             .BackColor = IIf( StrSearch = "Protocole adapté", &H80000005, &H80000004)
        End With
        With .Controls("Text_pente" & i & "_ini")
              .Enabled = IIf( StrSearch= "Protocole adapté", True, False)
             .BackColor = IIf( StrSearch = "Protocole adapté", &H80000005, &H80000004)
        End With
     Next i
 End With
End Sub

Private Sub Combo_prot_fin_Change()
With usf
    With .Combo_prot_fin
       StrSearch = .Text
    End With
    For i = 1 To 16
        With .Controls("Text_vit" & i & "_fin")
             .Enabled = IIf(StrSeach = "Protocole adapté", True, False)
             .BackColor = IIf( StrSearch = "Protocole adapté", &H80000005, &H80000004)
        End With
        With .Controls("Text_pente" & i & "_fin")
              .Enabled = IIf( StrSearch = "Protocole adapté", True, False)
             .BackColor = IIf( StrSearch = "Protocole adapté", &H80000005, &H80000004)
        End With
     Next i
 End With
End Sub
'fin protocole adapté
'Tapis roulant vs ergomètre
Private Sub Combo_app_fin_Change()
With usf
 With Combo_app_fin
  StrSearch = .Text
 End With
   With .Text_vit_ergo_max_fin
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
   With .Text_charge_ergo_max_fin
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
   With .Text_vit_tapis_max_fin
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
   With .Text_pente_max_fin
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
End With
End Sub

Private Sub Combo_app_ini_Change()
With usf
 With .Combo_app_ini
  StrSearch = .Text
 End With
   With .Text_vit_ergo_max_ini
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
   With .Text_charge_ergo_max_ini
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
   With .Text_vit_tapis_max_ini
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
   With .Text_pente_max_ini
        .Enabled = IIf( StrSearch = "Tapis roulant", False, True)
        .BackColor = IIf( StrSearch = "Tapis roulant", &H80000004, &H80000005)
   End With
End With
End Sub
Non testé
jean marie
 
Dernière édition:
Vote positif 0 Vote négatif
J

jptaz15

XLDnaute Nouveau
Bonjour MP59, Merci beaucoup pour le suivi. Malheureusement, lorsque j'essais d'ouvrir le formulaire d'un client avec le bouton modifier, les éléments qui sont situés dans "remplir2" ne réapparaissent pas dans le formulaire. Ceux de "remplir1" apparaissent sans problème... Aurais-tu un idée?

merci encore

Jean-Philippe
 
Vote positif 0 Vote négatif
J

jptaz15

XLDnaute Nouveau
Bonjour Jean-Marie,

je vais effectivement essayer cela pour faire du ménage dans mon code.

merci

Jean-Philippe
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Re
je n'arrive pas a retrouver ces Controls "Combo_prot_ini" etc etc peux tu m'orienter ?
, y'en a tellement lol
Usf est la variable qui représente le Userform .
je n'ai donc rien testé !
n'hésite pas
jean marie
 
Vote positif 0 Vote négatif

MP59

XLDnaute Occasionnel
Bonsoir à tous,
j'ai changé d'approche, supprimé l'éclatement en 2 sub, je n'ai gardé que remplir1 (qui contient tous les cas).
je lui ai fait subir une cure d'amaigrissement pour ne pas dépasser les 64k.
ex :
Dim SD
Set SD = Sheets("Data")
Dim W
Set W = Data_UF
moins de texte implique moins de poids
ça fonctionne (fichier joint).
 

Pièces jointes

  • Formulaire éval 2Vmp59.xlsm
    169.6 KB · Affichages: 11
Vote positif 0 Vote négatif
Solution

ChTi160

XLDnaute Barbatruc
Re
On pourrait aussi mettre
VB: 
Dim CelStart As Range
Set CelStart = Sheets("Data").Range("Data_Start")
pour remplacer les plus de 500 fois : "Sheets("Data").Range("Data_Start")"
jean marie
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
Re
on pourrait aussi , un exemple a continuer si ca marche lol
Ici pour les lignes de 25 à 88
VB: 
ii = 0
For i = 25 To 32 'condition associée
ii = ii + 1
CellStart.Offset(TargetRow, i).Value = Controls("Txt_condasso" & ii) 'Rx
Next i
ii = 0
For i = 33 To 56
ii = ii + 1
CellStart.Offset(TargetRow, i).Value = Controls("Text_rx" & ii) 'Rx
Next i
ii = 0
CellStart.Offset(TargetRow, 57).Value = Text_fr_age_ini ' facteur risque
CellStart.Offset(TargetRow, 58).Value = Text_fr_obesite_ini ' facteur risque
ii = 0
For i = 59 To 65
ii = ii + 1
CellStart.Offset(TargetRow, i).Value = Controls("Combo_fr" & ii & "_ini")
Next i
ii = 0
For i = 66 To 67
ii = ii + 1
CellStart.Offset(TargetRow, i).Value = Controls("Combo_malconnu" & ii & "_ini")
Next i
CellStart.Offset(TargetRow, 68).Value = Text_passe_sportif 'titre passé sportif
ii = 0
For i = 69 To 77
ii = ii + 1
CellStart.Offset(TargetRow, i).Value = Controls("Text_ps" & ii)
Next i
CellStart.Offset(TargetRow, 78).Value = Text_passe_actif 'Titre passé actif
ii = 0
For i = 79 To 87
ii = ii + 1
CellStart.Offset(TargetRow, i).Value = Controls("Text_pa" & ii)
Next i
CellStart.Offset(TargetRow, 88).Value = Text_apactuelle 'Titre act actuelle
jean marie
 
Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir,

Les deux procédures Combo_prot_ini_Change() et Sub Combo_prot_fin_Change() peuvent s'écrire:
VB: 
'protocole adapté
Private Sub Combo_prot_ini_Change()
Dim i As Long
   For i = 1 To 16
      Controls("Text_vit" & i & "_ini").Enabled = Combo_prot_ini.Text = "Protocole adapté"
      Controls("Text_pente" & i & "_ini").Enabled = Combo_prot_ini.Text = "Protocole adapté"
      Controls("Text_vit" & i & "_ini").BackColor = IIf(Combo_prot_ini.Text = "Protocole adapté", "&H80000005", "&H80000004")
      Controls("Text_pente" & i & "_ini").BackColor = IIf(Combo_prot_ini.Text = "Protocole adapté", "&H80000005", "&H80000004")
   Next i
End Sub

Private Sub Combo_prot_fin_Change()
Dim i As Long
   For i = 1 To 16
      Controls("Text_vit" & i & "_ini").Enabled = Combo_prot_fin.Text = "Protocole adapté"
      Controls("Text_pente" & i & "_ini").Enabled = Combo_prot_fin.Text = "Protocole adapté"
      Controls("Text_vit" & i & "_ini").BackColor = IIf(Combo_prot_fin.Text = "Protocole adapté", "&H80000005", "&H80000004")
      Controls("Text_pente" & i & "_ini").BackColor = IIf(Combo_prot_fin.Text = "Protocole adapté", "&H80000005", "&H80000004")
   Next i
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
J

jptaz15

XLDnaute Nouveau
Bonjour MP59, c'est génial, tout fonctionne. Ça m'ouvre aussi les yeux sur une manière de diminuer grandement le texte dans mes codes.

Merci beaucoup c'est vraiment apprécié d'avoir pris le temps

Au plaisir!
 
Vote positif 0 Vote négatif
J

jptaz15

XLDnaute Nouveau
Merci Jean-Marie!! Effectivement ça enlève beaucoup de lignes lol. Pour ma compréhension que représente le "i" exactement?

merci
Jean-Philippe
 
Vote positif 0 Vote négatif
J

jptaz15

XLDnaute Nouveau
jptaz15 à dit:
Bonjour Jean-Marie,

je vais effectivement essayer cela pour faire du ménage dans mon code.

merci

Jean-Philippe
Cliquez pour agrandir...
Bonjour Jean-Marie,

désolé de te revenir sur ce sujet qui date, mais j'ai essayé ta solution cette semaine et j'obtiens une message d'erreur, il semble que la variable "usf" ne soit pas définie. Je ne saurais pas en quoi la définir.

merci

Jean-Philippe
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

O
  • Question
XL 2019 boutons sur formulaire non fonctionnels
2 3
Réponses
35
Affichages
804
olivier1984
O
E
  • Résolu(e)
Microsoft 365 Procédure trop longue
2
Réponses
17
Affichages
1 K
TooFatBoy
O
  • Question
XL 2019 Formulaire vba pour filtrer les données
Réponses
7
Affichages
415
olivier1984
O
  • Question
XL 2021 Saisie de lignes multiples dans un formulaire
2
Réponses
15
Affichages
552
jeff1494
C
  • Question
XL 2021 Cellules qui ne s'effacent pas sur formulaire et renvoi de valeurs du formulaire
Réponses
1
Affichages
321
gbinforme
G
  • Résolu(e)
Microsoft 365 VBA : formule Excel en variable
2
Réponses
24
Affichages
1 K
mapomme
G
  • Résolu(e)
XL 2010 Mettre une textbox en négatif.
Réponses
6
Affichages
289
Phil69970
Q
  • Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
476
job75
D
  • Question
XL 2021 Formulaire de calcul des jours proratisés
Réponses
0
Affichages
430
Did25
D
J
  • Question
XL 2016 Problème de formulaire, checkbox dynamiques
Réponses
12
Affichages
537
Jingxi
J
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…