VBA: alléger code "select case" ??

[mikepers]

Bonsoir le forum !
j'utilise la fonction 'select case' pour déplacer des plages de données
en fonction de la valeur insérée dans une cellule ( ici O3).
le problème c'est que j'ai 20 fonction 'case' à chaque fois ( ici 2 seulement
sont représentés ) pour un nombre importants de modules ! le fichier risque
d'être trop lourd.
On remarque que dans mon cas, à chaque fois 2 zones de cellules sont déplacées
et ensuite les zones sources sont 'nettoyées'(Selection.ClearContents), et
ensuite une valeur FAUX est attribuée à 2 cellules- pour décocher 2 cases à
cocher d'options.
Cette 2eme partie de routine ( nettoyer, décocher ) est appliquer quelque soit
l'option 'case' ( c'est à dire peut importe la destination, à chaque fois la
routine se termine par le nettoyage et le décochage des même cellules).
Pour alléger le code, est il possible à votre avis de:
insérer dans les 'case' uniquement les valeurs de déplacement, et ensuite ne
répéter qu'une seule fois, en fin de routine, le code:

Range('K7:M16').Select
Selection.ClearContents
Range('K3:N5').Select
Selection.ClearContents
Range('G7:G16').Select
Selection.ClearContents
Range('P3').Value = FAUX
Range('P4').Value = FAUX

celà m'éviterai de taper à chaque fois ses fonctions qui sont les mêmes
quelque soit le 'case'.
Celà est il possible???Si oui, ou placer le code final????

Merci à vous
==================================
le code original:



Private Sub CommandButton2_Click()
' déplacement de la 1
If MsgBox('Repositionner la salle ?', _
vbYesNo + vbQuestion, 'Confirmation') = vbYes Then
Application.ScreenUpdating = False
Select Case Range('O3').Value
Case 1
Range('K7:M16').Select
Selection.Copy
Range('B7😀16').Select
ActiveSheet.Paste
Range('K3:N5').Select
Application.CutCopyMode = False
Selection.Copy
Range('B3:E5').Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range('K7:M16').Select
Selection.ClearContents
Range('K3:N5').Select
Selection.ClearContents
Range('G7:G16').Select
Selection.ClearContents
Range('P3').Value = FAUX
Range('P4').Value = FAUX

Case 2
Range('K7:M16').Select
Selection.Copy
Range('B31😀40').Select
ActiveSheet.Paste
Range('K3:N5').Select
Application.CutCopyMode = False
Selection.Copy
Range('B27:E29').Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range('K7:M16').Select
Selection.ClearContents
Range('K3:N5').Select
Selection.ClearContents
Range('G7:G16').Select
Selection.ClearContents
Range('P3').Value = FAUX
Range('P4').Value = FAUX

 

[CBernardT]

Re:VBA: alléger code \"select case\" ??

Bonjour Mikepers et le forum,

La syntaxe peur être de ce style :

Private Sub CommandButton2_Click()
' déplacement de la 1
If MsgBox('Repositionner la salle ?', _
vbYesNo + vbQuestion, 'Confirmation') = vbYes Then
Application.ScreenUpdating = False
Select Case Range('O3').Value
Case 1
Range('K7:M16').Copy Range('B7😀16')
Range('K3:N5').Copy Range('B3:E5')
Effacer
Case 2
Range('K7:M16').Copy Range('B31😀40')
Range('K3:N5').Copy Range('B27:E29')
Effacer
End Select
End If
End Sub

Sub Effacer()
Range('K7:M16').ClearContents
Range('K3:N5').ClearContents
Range('G7:G16').ClearContents
Range('P3').Value = 'FAUX'
Range('P4').Value = 'FAUX'
End Sub

Cordialement

Bernard

Message édité par: CBernardT, à: 25/06/2006 08:58

 

[mikepers]

Bonjour CBernardT.

Ton code à l'air extra !!
je teste dès que possible.
Merci beaucoup pour ton aide.

 

[mikepers]

Oups,,,
j'ai oublié: à la fin du module, j'ai aussi une
instruction ' c
Case Else 'si non connu
MsgBox 'Cette salle n'existe pas !'
End Select
End If

End Sub

 

[mikepers]

désolé ...post du haut non terminé()
J'ai donc oublié: à la fin du module, j'ai aussi une
instruction ' case else', pour affichage d'un message d'erreur au cas ou un numéro non valide est entré en O3
Ou dois je mettre ce code???
??????????????????????????????????????
Case Else 'si non connu
MsgBox 'Cette salle n'existe pas !'
End Select
End If

Bien à toi

 

[Dan]

Bonsoir,

Place l'instruction

Case Else 'si non connu 
MsgBox 'Cette salle n'existe pas !'

entreEffacer et End Select

😉

 

[mikepers]

merci beaucoup Dan, ça marche !!
Un énorme merci à toutes ces personnes du forum, qui répondent rapidement et avec passion. Grace à vous et à cet Excellent forum, j'ai évolué et je comprends un petit peu mieux le code.

 

[Mytå]

Re:VBA: alléger code \"select case\" ??

Salut le Forum

Pourquoi ajouter un module Sub Effacer() quand
on peut tous incorporer dans la même Sub().

Private Sub CommandButton2_Click()

' Déplacement selon valeur dans la cellule $O$3

If MsgBox('Repositionner la salle ?', _
vbYesNo + vbQuestion, 'Confirmation') = vbYes Then
Application.ScreenUpdating = False

Select Case Range('O3').Value

Case 1
Range('K7:M16').Copy Range('B7:D16')
Range('K3:N5').Copy Range('B3:E5')

Case 2
Range('K7:M16').Copy Range('B31:D40')
Range('K3:N5').Copy Range('B27:E29')

'Case X à ajouter ici pour d'autres valeurs de $O$3

Case Else 'Valeur hors limite
MsgBox 'Cette salle n'existe pas !'
Application.ScreenUpdating = True
Exit Sub

End Select

Range('K7:M16').ClearContents
Range('K3:N5').ClearContents
Range('G7:G16').ClearContents
Range('P3').Value = False
Range('P4').Value = False
Application.ScreenUpdating = True

End If

End Sub

Mytå

P.S. Juste la suite d'un Post répondu sur un autre Forum.

Message édité par: Mytå, à: 27/06/2006 02:33