comment répéter une macro simplemment

Version imprimable

bonjour,
Je débute tout juste avec le VBA et évidemment j'ai des soucis :(
J'ai cette macro que j'aimerai d'une part simplifier au maximum car il va falloir que j'en fasse d'autres qui lui ressemblent.
Et d'autre part, je voudrai pouvoir la reproduire d'un coup à partir de plusieurs cellules sélectionnées(par forcément sur la même ligne) avec un "ctrl + clic"
Et la ouyouyouy je galère

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub occupation_LP1_V30_1()
 
    ActiveCell.Value = 1
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(6, 1).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(9, 5).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 0.5
    ActiveCell.Offset(9, 1).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(9, 3).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 1
    ActiveCell.Offset(1, 0).Select
 
End Sub

Merci d'avance

Bonjour
D'abord pour simplifier ton code, pas besoin de Select
Ton code aura l'allure suivante
Code:

1 2 3 4 5 6 7 8 9 10 Sub occupation_LP1_V30_1() With ActiveCell .Resize(1, 2) = 1 .Offset(6, 2).Resize(1, 2) = 1 .Offset(15, 8).Resize(1, 9) = 0.5 .Offset(24, 17).Resize(1, 2) = 1 .Offset(33, 21).Resize(1, 2) = 1 End With End Sub
Fais un F1 sur Resize pour comprendre.

Personnellement, j'évite au maximum de travailler avec les Activecell mais reste à savoir ton besoin.

09/04/2012, 12h53
BlueMonkey

Bonjour,

Citation:

Et d'autre part, je voudrai pouvoir la reproduire d'un coup à partir de plusieurs cellules sélectionnées(par forcément sur la même ligne) avec un "ctrl + clic"

voir :
comment lancer une macro depuis la barre de lancement rapide.
Comment créer une barre d'outil personnel pour lancer une macro

Une autre proposition permettant de lancer le code par double clique sur la cellule concernée (qui était dans ton cas ActiveCell).

Codes à mettre dans le module de la feuille

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
'on peut accessoirement limiter l'appel à certaines cellules
Cancel = True
With Target
    .Resize(1, 2) = 1
    .Offset(6, 2).Resize(1, 2) = 1
    .Offset(15, 8).Resize(1, 9) = 0.5
    .Offset(24, 17).Resize(1, 2) = 1
    .Offset(33, 21).Resize(1, 2) = 1
End With
End Sub

09/04/2012, 16h43
reivilo49

En ce qui concerne la première partie, c 'est impressionnant de voir comment tu arrives à faire une macro qui donne le même résultat mais bien plus simple.

En revanche, pour la 2ème partie, ce n est pas avec le double clic qui m’intéresse. Je vais essayer de m'expliquer correctement :

Lorsque je sélectionne plusieurs cellules en même temps avec la touche "ctrl" et le clic de la souris, ces cellules passent en une sorte de surbrillance. Et bien, je voudrais que pour chacune de ces cellules choisies, la macro s’exécute.

Voilà bon courage et encore merci.

Tu peux sélection tes cellules (en maintenant la touche Ctrl enfoncée)
Après, toujours avec la touche Ctrl clique droit.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Rg As Range
 
'on peut accessoirement limiter l'appel à certaines cellules
Cancel = True
For Each Rg In Target 'Ou Selection
    With Rg
        .Resize(1, 2) = 1
        .Offset(6, 2).Resize(1, 2) = 1
        .Offset(15, 8).Resize(1, 9) = 0.5
        .Offset(24, 17).Resize(1, 2) = 1
        .Offset(33, 21).Resize(1, 2) = 1
    End With
Next Rg
End Sub