FONCTION VBA beaucoup trop grande....

[alain.raphael]

Bonjour à Tous,

J'ai une Fonction SUB > à 64 Ko, et je ne sais pas comment la réduire.

J'ai des champs dans un formulaire (Date, numéro....) et des CheckBox concernant 24 personnes.

Si je sélectionne les CheckBox 1 et 3, les données des champs se remplissent après validation du formulaire dans les pages des personnes 1 et 3, mais aussi le nom des autres personnes des checkBox cochées :

Exemple : CheckBox 1, 3, 4 cochées : sur la page 1 le nom des personnes 3 et 4 s'affichent (ainsi que les données)
sur la page 3 le nom des personnes 1 et 4 s'affichent
sur la page 4 le nom des personnes 1 et 3 s'affichent.

Ci-joint le code :

Private Sub VALIDERINDIVIDU_Click()
'declaration des variables
Dim DatePlongee As String * 10
Dim LieuPlongee As String * 60
Dim CommunePlonge As String * 30
Dim EICSTPlongee As String
Dim ButPlongee As String * 100
Dim HeureDebutimmersionPlongee As String
Dim HeureFinimmersionPlongee As String
Dim DureePLongee As String * 3
Dim ProfondeurPlongee As String * 2
Dim CourantPlongee As String
Dim Ecriture As Boolean
Dim VisibilitePlongee As String
Dim TemperaturePlongee As String
Dim NomDPPlongee As String
Dim NumLigne, NbPlongees As Integer
Dim Cellule As String

'Affectations des variables

DatePlongee = Da.Text
LieuPlongee = Lieu.Text
CommunePlongee = Com.Text
EICSTPlongee = ComboBoxEICST.Value
ButPlongee = But.Text
HeureDebutimmersionPlongee = Hd.Value
HeureFinimmersionPlongee = Hf.Value
DureePLongee = Duree.Text
ProfondeurPlongee = Pro.Text
CourantPlongee = ComboBoxCou.Value
VisibilitePlongee = ComboBoxVisi.Value
TemperaturePlongee = T.Text
NomDPPlongee = ComboBoxDP.Value


Range("A7").Select


'Avertissement que les champs soient remplis
If DatePlongee = "" Or LieuPlongee = "" Or CommunePlongee = "" Or EICSTPlongee = "" Or ButPlongee = "" Or HeureDebutimmersionPlongee = "" Or HeureFinimmersionPlongee = "" Or DureePLongee = "" Or ProfondeurPlongee = "" Or CourantPlongee = "" Or VisibilitePlongee = "" Or TemperaturePlongee = "" Or NomDPPlongee = "" Then
Reponse = MsgBox("Vous avez oublié de remplir certains champs !!", 0, "Informations manquantes")

Else


'insertion des valeurs sur les feuilles individuelles

If CheckBox1.Value Then

NumLigne = Feuil4.Range("a65536").End(xlUp).Row + 1
Feuil4.Cells(NumLigne, 1) = NumLigne - 6
Feuil4.Cells(NumLigne, 2) = CDate(Da.Value)
Feuil4.Cells(NumLigne, 3) = Lieu.Value
Feuil4.Cells(NumLigne, 4) = Com.Value
Feuil4.Cells(NumLigne, 5) = ComboBoxEICST.Value
Feuil4.Cells(NumLigne, 6) = But.Value
Feuil4.Cells(NumLigne, 7) = Hd.Value
Feuil4.Cells(NumLigne, 8) = Hf.Value
Feuil4.Cells(NumLigne, 9) = Duree.Value
Feuil4.Cells(NumLigne, 10) = Pro.Value
Feuil4.Cells(NumLigne, 11) = ComboBoxCou.Value
Feuil4.Cells(NumLigne, 12) = ComboBoxVisi.Value
Feuil4.Cells(NumLigne, 13) = T.Value
Feuil4.Cells(NumLigne, 14) = ComboBoxDP.Value
  If CheckBox2.Value Then
 Feuil4.Cells(NumLigne, 17) = "2"
 Else
 Feuil4.Cells(NumLigne, 17) = ""
 End If
  If CheckBox3.Value Then
 Feuil4.Cells(NumLigne, 18) = "3"
 Else
 Feuil4.Cells(NumLigne, 18) = ""
 End If
  If CheckBox4.Value Then
 Feuil4.Cells(NumLigne, 19) = "4"
 Else
 Feuil4.Cells(NumLigne, 19) = ""
 End If
  If CheckBox5.Value Then
 Feuil4.Cells(NumLigne, 20) = "5"
 Else
 Feuil4.Cells(NumLigne, 20) = ""
 End If
  If CheckBox6.Value Then
 Feuil4.Cells(NumLigne, 21) = "6"
 Else
 Feuil4.Cells(NumLigne, 21) = ""
 End If
  If CheckBox7.Value Then
 Feuil4.Cells(NumLigne, 22) = "7"
 Else
 Feuil4.Cells(NumLigne, 22) = ""
 End If
  If CheckBox8.Value Then
 Feuil4.Cells(NumLigne, 23) = "8"
 Else
 Feuil4.Cells(NumLigne, 23) = ""
 End If
  If CheckBox9.Value Then
 Feuil4.Cells(NumLigne, 24) = "9"
 Else
 Feuil4.Cells(NumLigne, 24) = ""
 End If
  If CheckBox10.Value Then
 Feuil4.Cells(NumLigne, 25) = "10"
 Else
 Feuil4.Cells(NumLigne, 25) = ""
 End If
  If CheckBox11.Value Then
 Feuil4.Cells(NumLigne, 26) = "11"
 Else
 Feuil4.Cells(NumLigne, 26) = ""
 End If
  If CheckBox12.Value Then
 Feuil4.Cells(NumLigne, 27) = "12"
 Else
 Feuil4.Cells(NumLigne, 27) = ""
 End If
  If CheckBox13.Value Then
 Feuil4.Cells(NumLigne, 28) = "13"
 Else
 Feuil4.Cells(NumLigne, 28) = ""
 End If
  If CheckBox14.Value Then
 Feuil4.Cells(NumLigne, 29) = "14"
 Else
 Feuil4.Cells(NumLigne, 29) = ""
 End If
  If CheckBox15.Value Then
 Feuil4.Cells(NumLigne, 30) = "15"
 Else
 Feuil4.Cells(NumLigne, 30) = ""
 End If
  If CheckBox16.Value Then
 Feuil4.Cells(NumLigne, 31) = "16"
 Else
 Feuil4.Cells(NumLigne, 31) = ""
 End If
  If CheckBox17.Value Then
 Feuil4.Cells(NumLigne, 33) = "17"
 Else
 Feuil4.Cells(NumLigne, 33) = ""
 End If
  If CheckBox18.Value Then
 Feuil4.Cells(NumLigne, 34) = "18"
 Else
 Feuil4.Cells(NumLigne, 34) = ""
 End If
  If CheckBox19.Value Then
 Feuil4.Cells(NumLigne, 35) = "19"
 Else
 Feuil4.Cells(NumLigne, 35) = ""
 End If
 If CheckBox20.Value Then
 Feuil4.Cells(NumLigne, 36) = "20"
 Else
 Feuil4.Cells(NumLigne, 36) = ""
 End If
  If CheckBox21.Value Then
 Feuil4.Cells(NumLigne, 37) = "21"
 Else
 Feuil4.Cells(NumLigne, 37) = ""
 End If
  If CheckBox22.Value Then
 Feuil4.Cells(NumLigne, 38) = "22"
 Else
 Feuil4.Cells(NumLigne, 38) = ""
 End If
  If CheckBox23.Value Then
 Feuil4.Cells(NumLigne, 39) = "23"
 Else
 Feuil4.Cells(NumLigne, 39) = ""
 End If
  If CheckBox24.Value Then
 Feuil4.Cells(NumLigne, 40) = "24"
 Else
 Feuil4.Cells(NumLigne, 40) = ""
 End If

End If

  'insertion des valeurs sur les feuilles individuelles

If CheckBox2.Value Then

NumLigne = Feuil5.Range("a65536").End(xlUp).Row + 1
Feuil5.Cells(NumLigne, 1) = NumLigne - 6
Feuil5.Cells(NumLigne, 2) = CDate(Da.Value)
Feuil5.Cells(NumLigne, 3) = Lieu.Value
Feuil5.Cells(NumLigne, 4) = Com.Value
Feuil5.Cells(NumLigne, 5) = ComboBoxEICST.Value
Feuil5.Cells(NumLigne, 6) = But.Value
Feuil5.Cells(NumLigne, 7) = Hd.Value
Feuil5.Cells(NumLigne, 8) = Hf.Value
Feuil5.Cells(NumLigne, 9) = Duree.Value
Feuil5.Cells(NumLigne, 10) = Pro.Value
Feuil5.Cells(NumLigne, 11) = ComboBoxCou.Value
Feuil5.Cells(NumLigne, 12) = ComboBoxVisi.Value
Feuil5.Cells(NumLigne, 13) = T.Value
Feuil5.Cells(NumLigne, 14) = ComboBoxDP.Value
  If CheckBox1.Value Then
 Feuil5.Cells(NumLigne, 16) = "1"
 Else
 Feuil5.Cells(NumLigne, 16) = ""
 End If
  If CheckBox3.Value Then
 Feuil5.Cells(NumLigne, 18) = "3"
 Else
 Feuil5.Cells(NumLigne, 18) = ""
 End If

                                                                 Etc…….

End If

                                                  ETC…POUR LES 22 autres CHECKBOX…….

'fin
If MsgBox("Une fois affectée, Pensez à VALIDER la Plongée", vbOKOnly, "2ème bouton") = vbOK Then

Range("A1").Select

End If
End If
End Sub

 

[alain.raphael]

Re : FONCTION VBA beaucoup trop grande....

Oui...exactement !! (+ bien évidemment les champs textes)...

MERCI....

J'ai presque fini de dépoussiérer le fichier...

 

[alain.raphael]

Re : FONCTION VBA beaucoup trop grande....

Ci-joint le fichier pour une meilleure idée :

Mon code fonctionne bien....mais si je continue à rajouter le code pour chaque personne....il devient trop grand.

ICI

 

[Paf]

Re : FONCTION VBA beaucoup trop grande....

re,

Heu... là c'est moi qui vais avoir besoin de vos conseils: impossible d'avoir accès au classeur !!

A+

 

[Staple1600]

Re : FONCTION VBA beaucoup trop grande....

Re

Paf:
Quel est ton navigateur?
En tout cas, 4Mo pour un fichier exemple, je passe mon chemin

 

[alain.raphael]

Re : FONCTION VBA beaucoup trop grande....

La mise en page prends beaucoup de place je pense ;-)

 

[Paf]

Re : FONCTION VBA beaucoup trop grande....

merci Staple1600
Navigateur Firefox 21.0

J'ai un cadre rouge mentionnant :< Valider et télécharger le fichier> mais aucune action possible dessus !

 

[alain.raphael]

Re : FONCTION VBA beaucoup trop grande....

Mince....sur Chrome le lien marche bien.

J'ai oublié de préciser que la fonction SUB trop longue est sur le 1er bouton de validation du formulaire.

 

[alain.raphael]

Re : FONCTION VBA beaucoup trop grande....

Sur IE cela a l'air de fonctionner aussi...

 

[Paf]

Re : FONCTION VBA beaucoup trop grande....

Bon ben..... je passe la main

bonne suite

 

[Staple1600]

Re : FONCTION VBA beaucoup trop grande....

Re

Paf
Essaies avec IE.

alain.raphael
Il vaut mieux joindre un fichier exemple allégé
(4Mo ce n'est pas vraiment léger, non ?)
Tu peux aussi allégé puis compresser ton classeur (Clic-droit -> Envoyer vers Dossiers Compressés )
et tu pourras alors joindre ton fichier directement ici sur le forum.

 

[Paf]

Re : FONCTION VBA beaucoup trop grande....

Re,
j'utilise AdBlock Plus et c'est ce qui me bloquait l'accès à la validation!

 

[Staple1600]

Re : FONCTION VBA beaucoup trop grande....

Re

Paf
Avec ou sans AdBlockPlus, 4Mo reste 4Mo!
Chez moi, c'est cela qui bloque (et ce quel que soit le navigateur employé)

 

[Paf]

Re : FONCTION VBA beaucoup trop grande....

Re,

je viens de regarder le classeur : 4 Mo pour un fichier vide !!

le problème qui pouvait peut-être être simple risque d'être compliqué par le choix des noms de Checkbox ( qui reprend le nom des plongeurs !!)

S'il était possible de renommer simplement les checkbox en Chechbox1, CheckBox2 ....ce serait plus simple!

Je réfléchis à ça en soirée

A+

A+

 

[alain.raphael]

Re : FONCTION VBA beaucoup trop grande....

Merci !! Ca soulage le moral.

Il est vrai que je ne sais pas trop d'où vienne ces 4Mo car en gros 25 feuillets, un formulaire et 2 boutons avec fonction SUB...

 

[Efgé]

Re : FONCTION VBA beaucoup trop grande....

Re

Il est vrai que je ne sais pas trop d'où vienne ces 4Mo car en gros 25 feuillets, un formulaire et 2 boutons avec fonction SUB...

Problème récurent du fichier obèse....

En se mettant en $A$1 des feuilles et faisant Ctrl+Shift+Fin on vois bien la plage vue par Excel.....

La mise en forme sur des colonnes entières.............

En supprimant les lignes / colonnes inutilisées, on se change la vie....

Cordialement