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
MP59
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

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

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
MP59 à dit:
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
Cliquez pour agrandir...
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
ChTi160 à dit:
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
Cliquez pour agrandir...
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

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

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

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

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
MP59 à dit:
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).
Cliquez pour agrandir...
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
ChTi160 à dit:
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
Cliquez pour agrandir...
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

Discussions similaires

O
  • Question
XL 2019 boutons sur formulaire non fonctionnels
2 3
Réponses
35
Affichages
793
olivier1984
O
E
  • Résolu(e)
Microsoft 365 Procédure trop longue
2
Réponses
17
Affichages
1 K
TooFatBoy
TooFatBoy
O
  • Question
XL 2019 Formulaire vba pour filtrer les données
Réponses
7
Affichages
413
olivier1984
O
jeff1494
  • Question
XL 2021 Saisie de lignes multiples dans un formulaire
2
Réponses
15
Affichages
548
jeff1494
jeff1494
C
  • Question
XL 2021 Cellules qui ne s'effacent pas sur formulaire et renvoi de valeurs du formulaire
Réponses
1
Affichages
317
gbinforme
G
Bernard38
  • Résolu(e)
Microsoft 365 VBA : formule Excel en variable
2
Réponses
24
Affichages
1 K
mapomme
mapomme
G
  • Résolu(e)
XL 2010 Mettre une textbox en négatif.
Réponses
6
Affichages
285
Phil69970
Phil69970
Q
  • Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
470
job75
job75
D
  • Question
XL 2021 Formulaire de calcul des jours proratisés
Réponses
0
Affichages
422
Did25
D
J
  • Question
XL 2016 Problème de formulaire, checkbox dynamiques
Réponses
12
Affichages
530
Jingxi
J

Membres actuellement en ligne

14 membres et 143 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 717
Messages
2 112 169
Membres
111 449
dernier inscrit
jhugot