XL 2010 Procédure trop longue VBA - formulaire

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion jptaz15
  • 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 !

S'inscrire
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

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

Vote positif 0 Vote négatif
Solution
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
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
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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

M
  • Question Question
XL 2016 liste déroulante formulaire vba excel
2
Réponses
20
Affichages
227
fanch55
fanch55
jeff1494
  • Question Question
XL 2021 Saisie de lignes multiples dans un formulaire
2
Réponses
15
Affichages
737
jeff1494
jeff1494
O
  • Question Question
XL 2019 Formulaire vba pour filtrer les données
Réponses
7
Affichages
520
olivier1984
O
E
  • Résolu(e)
Microsoft 365 Procédure trop longue
2
Réponses
17
Affichages
1 K
TooFatBoy
TooFatBoy
C
  • Question Question
XL 2021 Cellules qui ne s'effacent pas sur formulaire et renvoi de valeurs du formulaire
Réponses
1
Affichages
383
gbinforme
G
Bernard38
  • Résolu(e)
Microsoft 365 VBA : formule Excel en variable
2
Réponses
24
Affichages
1 K
mapomme
mapomme
N
  • Résolu(e)
Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système
18 19 20
Réponses
297
Affichages
67 K
NONO14
N
N
  • Résolu(e)
Microsoft 365 Format date d'une textbox vers une cellule
Réponses
8
Affichages
618
ChTi160
ChTi160
G
  • Résolu(e)
XL 2010 Mettre une textbox en négatif.
Réponses
6
Affichages
335
Phil69970
Phil69970
D
  • Question Question
XL 2021 Formulaire de calcul des jours proratisés
Réponses
0
Affichages
513
Did25
D
B
  • Question Question
XL 2016 VBA formulaire incrémenter un N° de facture selon l'année(mais dates sur deux colonnes)
Réponses
4
Affichages
624
badduke
B
V
  • Résolu(e)
Microsoft 365 Barre de recherche : comment rendre éditable le résultat ?
2 3 4
Réponses
52
Affichages
638
dysorthographie
dysorthographie
patricktoulon
  • Question Question
Autres toutes versions tester le scrool avec la roulette sans passer par un hooking en addressof
Réponses
2
Affichages
57
patricktoulon
patricktoulon
D
  • Question Question
XL 2016 Future date la plus proche d'aujourd'hui + mise en forme conditionnelle
Réponses
8
Affichages
119
vgendron
vgendron
A
  • Question Question
XL 2019 Filtre avancé en VBA
Réponses
12
Affichages
695
Amilo
A
J
  • Question Question
XL 2016 Problème de formulaire, checkbox dynamiques
Réponses
12
Affichages
600
Jingxi
J
Eric C
  • Résolu(e)
XL 2010 Propriété MaxLength d'une TextBox pour saisie n° de téléphone
2
Réponses
23
Affichages
2 K
Eric C
Eric C
C
  • Question Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
1 K
TooFatBoy
TooFatBoy
mromain
Userform, DatePicker, TimePicker, et autres
Réponses
0
Affichages
1 K
mromain
mromain
J
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
794
jebibo
J
Retour