Discussion :

[reivilo49]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[mercatog]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[BlueMonkey]

Bonjour,

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

[mercatog]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.

[mercatog]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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