Déplacement ActiveCell pour apprendre

Le
xem
Bonsoir à toutes et tous,

Il existe certainement une manière plus pro
d'écrire le bout de code suivant !!!!

Private Sub DepCible_Click()

For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 1).Select
Next Compteur

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, -1).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(-1, 0).Select
Next Compteur
End If

End Sub

Merci d'avance
Xem
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
xem
Le #1847128
Re

Je viens de voir que je n'ai pas besoin de If ...Then

Private Sub DepCible_Click()

For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 1).Select
Next Compteur

For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Select
Next Compteur
For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, -1).Select
Next Compteur

For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(-1, 0).Select
Next Compteur

End Sub

Peut-on faire d'une autre façon ?

Merci a+
Xem

"xem" news:
Bonsoir à toutes et tous,

Il existe certainement une manière plus pro
d'écrire le bout de code suivant !!!!

Private Sub DepCible_Click()

For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 1).Select
Next Compteur

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, -1).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(-1, 0).Select
Next Compteur
End If

End Sub

Merci d'avance
Xem




Michel Pierron
Le #1847071
Bonsoir xem;
Pas forcément plus pro:
For Compteur = 1 To 4
ActiveCell.Offset(0, Compteur).Interior.ColorIndex = 3
Next Compteur

MP

"xem" news:
Bonsoir à toutes et tous,

Il existe certainement une manière plus pro
d'écrire le bout de code suivant !!!!

Private Sub DepCible_Click()

For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 1).Select
Next Compteur

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, -1).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(-1, 0).Select
Next Compteur
End If

End Sub

Merci d'avance
Xem




michdenis
Le #1847067
Bonjour Xem,

Il y a aussi ceci sans boucle.

compteur = 4
ActiveCell.Resize(, compteur).Interior.ColorIndex = 3


Salutations!



"xem" Bonsoir à toutes et tous,

Il existe certainement une manière plus pro
d'écrire le bout de code suivant !!!!

Private Sub DepCible_Click()

For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 1).Select
Next Compteur

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, -1).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(-1, 0).Select
Next Compteur
End If

End Sub

Merci d'avance
Xem
docm
Le #1847002
Bonjour.

Ce qui pourrait donner ceci par exemple:

r = ActiveCell.Row
c = ActiveCell.Column

Cells(r, c).Resize(1, 5).Interior.ColorIndex = 3
Cells(r + 12, c).Resize(1, 5).Interior.ColorIndex = 3

Cells(r + 1, c).Resize(11, 1).Interior.ColorIndex = 4
Cells(r + 1, c + 4).Resize(11, 1).Interior.ColorIndex = 4


"michdenis" news:
Bonjour Xem,

Il y a aussi ceci sans boucle.

compteur = 4
ActiveCell.Resize(, compteur).Interior.ColorIndex = 3


Salutations!



"xem" news:

Bonsoir à toutes et tous,

Il existe certainement une manière plus pro
d'écrire le bout de code suivant !!!!

Private Sub DepCible_Click()

For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(0, 1).Select
Next Compteur

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(1, 0).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 8
ActiveCell.Offset(0, -1).Select
Next Compteur
End If

If ActiveCell.Interior.ColorIndex = xlNone Then
For Compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 6
ActiveCell.Offset(-1, 0).Select
Next Compteur
End If

End Sub

Merci d'avance
Xem





xem
Le #1850357
Merci pour vos réponses très instructives,

je découvre qu'en gardant les boucles , en travaillant
avec l'offset et la couleur ça permet de créer des animations
diverses d'où ma question:
Est--il possible au nveau de Sheet ou WorkBook
et pourquoi pas d'une Cell à l'autre de temporiser
le déplacement de ActiveCell ?
Si oui, un petit bout de code peut être ?

Mes élucubrations ( très, très, très modestement)
Private Sub DepCible_Click()

For i = 1 To 5

For compteur = 1 To 4
ActiveCell.Offset(0, 1).Interior.ColorIndex = 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(0, 1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).Interior.ColorIndex = xlNone
Next compteur

Next i

End Sub

J'aurai peut être mieux fait de créer un autre fil !
Merci
Xem

"
docm
Le #1847224
Bonjour xem.

Après cette déclaration:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Glisse quelques
Sleep (100) ' un dixième de seconde d'attente
dans ton code.

Amicalement

"xem" news:
Merci pour vos réponses très instructives,

je découvre qu'en gardant les boucles , en travaillant
avec l'offset et la couleur ça permet de créer des animations
diverses d'où ma question:
Est--il possible au nveau de Sheet ou WorkBook
et pourquoi pas d'une Cell à l'autre de temporiser
le déplacement de ActiveCell ?
Si oui, un petit bout de code peut être ?

Mes élucubrations ( très, très, très modestement)
Private Sub DepCible_Click()

For i = 1 To 5

For compteur = 1 To 4
ActiveCell.Offset(0, 1).Interior.ColorIndex = 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(0, 1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).Interior.ColorIndex = xlNone
Next compteur

Next i

End Sub

J'aurai peut être mieux fait de créer un autre fil !
Merci
Xem

"




xem
Le #1847666
Merci docm,
Impec.

Cordialement
Xem
"docm" news:
Bonjour xem.

Après cette déclaration:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Glisse quelques
Sleep (100) ' un dixième de seconde d'attente
dans ton code.

Amicalement

"xem" news:
Merci pour vos réponses très instructives,

je découvre qu'en gardant les boucles , en travaillant
avec l'offset et la couleur ça permet de créer des animations
diverses d'où ma question:
Est--il possible au nveau de Sheet ou WorkBook
et pourquoi pas d'une Cell à l'autre de temporiser
le déplacement de ActiveCell ?
Si oui, un petit bout de code peut être ?

Mes élucubrations ( très, très, très modestement)
Private Sub DepCible_Click()

For i = 1 To 5

For compteur = 1 To 4
ActiveCell.Offset(0, 1).Interior.ColorIndex = 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(0, 1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).Interior.ColorIndex = xlNone
Next compteur

Next i

End Sub

J'aurai peut être mieux fait de créer un autre fil !
Merci
Xem

"








docm
Le #1849096
Tout le plaisir, ou presque, est pour moi.

"xem" news:#
Merci docm,
Impec.

Cordialement
Xem
"docm" news:
Bonjour xem.

Après cette déclaration:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Glisse quelques
Sleep (100) ' un dixième de seconde d'attente
dans ton code.

Amicalement

"xem" news:
Merci pour vos réponses très instructives,

je découvre qu'en gardant les boucles , en travaillant
avec l'offset et la couleur ça permet de créer des animations
diverses d'où ma question:
Est--il possible au nveau de Sheet ou WorkBook
et pourquoi pas d'une Cell à l'autre de temporiser
le déplacement de ActiveCell ?
Si oui, un petit bout de code peut être ?

Mes élucubrations ( très, très, très modestement)
Private Sub DepCible_Click()

For i = 1 To 5

For compteur = 1 To 4
ActiveCell.Offset(0, 1).Interior.ColorIndex = 1
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 0).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 4
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(0, 1).Interior.ColorIndex = xlNone
Next compteur

For compteur = 1 To 12
ActiveCell.Interior.ColorIndex = 1
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).Interior.ColorIndex = xlNone
Next compteur

Next i

End Sub

J'aurai peut être mieux fait de créer un autre fil !
Merci
Xem

"












sabatier
Le #1849087
comment "ou presque"? c'est quoi cette réserve, docm? une façon de ne pas
vouloir plagier notre philippe R, grand ordonnateur du plaisir sous toutes
ses formes?
jps

"docm" news:%23qN%
Tout le plaisir, ou presque, est pour moi.



Pierre Fauconnier
Le #1849083
Salut JPS,

J'aimerais, pour ma curiosité lubrique personnelle (sic), que tu m'expliques
comment tu sais que Philippe est Grand Ordonnateur de Plaisir SOUS TOUTES
SES FORMES ( les formes de qui, d'abord...)

Pierre

PS: que les oreilles chastes ne lisent pas ce message :)

"sabatier" de news:%
comment "ou presque"? c'est quoi cette réserve, docm? une façon de ne pas
vouloir plagier notre philippe R, grand ordonnateur du plaisir sous toutes
ses formes?
jps

"docm" news:%23qN%
Tout le plaisir, ou presque, est pour moi.







Publicité
Poster une réponse
Anonyme