Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Déplacement ActiveCell pour apprendre

Déplacement ActiveCell pour apprendre

11 réponses
Avatar
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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
xem
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" a écrit dans le message de
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




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

MP

"xem" a écrit dans le message de
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




Avatar
michdenis
Bonjour Xem,

Il y a aussi ceci sans boucle.

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


Salutations!



"xem" a écrit dans le message de 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
Avatar
docm
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" wrote in message
news:
Bonjour Xem,

Il y a aussi ceci sans boucle.

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


Salutations!



"xem" a écrit dans le message de
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





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

"
Avatar
docm
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" wrote in message
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

"




Avatar
xem
Merci docm,
Impec.

Cordialement
Xem
"docm" a écrit dans le message de
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" wrote in message
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

"








Avatar
docm
Tout le plaisir, ou presque, est pour moi.

"xem" wrote in message
news:#
Merci docm,
Impec.

Cordialement
Xem
"docm" a écrit dans le message de
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" wrote in message
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

"












Avatar
sabatier
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" a écrit dans le message de
news:%23qN%
Tout le plaisir, ou presque, est pour moi.



Avatar
Pierre Fauconnier
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" a écrit dans le message
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" a écrit dans le message de
news:%23qN%
Tout le plaisir, ou presque, est pour moi.







1 2