Discussion :

[pit22]

Bonjour à tous,

Première fois que j'écris sur un forum, je suis en formation de cadre en maison de retraite. Je n'y connais rien en VBA, mais je vais apprendre ce code d'ici quelques mois, j'en ai trop besoin. D'ici là, je dois rapidement créer un tableau pour le suivi des soins dans la maison de retraite ou je travail. J'ai besoin d'un code qui entoure des cases spécifiques, qui correspondent à des soins à effectuer (je n'arrive pas à joindre le fichier Excel, alors je fais un print screen). Le code correspondant au bouton de commande noir est :

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
Private Sub CommandButton6_Click()
'
' ENTOURER Macro
'
 
'
    Range("C9").Select
    ActiveSheet.Paste
    Range("F9").Select
    ActiveSheet.Paste
    Range("I9").Select
    ActiveSheet.Paste
    Range("L9").Select
    ActiveSheet.Paste
    Range("O9").Select
    ActiveSheet.Paste
    Range("R9").Select
    ActiveSheet.Paste
    Range("U9").Select
    ActiveSheet.Paste
    Range("X9").Select
    ActiveSheet.Paste
    Range("AA9").Select
    ActiveSheet.Paste
    Range("AD9").Select
    ActiveSheet.Paste
    Range("AG9").Select
    ActiveSheet.Paste
    Range("AJ9").Select
    ActiveSheet.Paste
    Range("AM9").Select
    ActiveSheet.Paste
    Range("AP9").Select
    ActiveSheet.Paste
    Range("AS9").Select
    ActiveSheet.Paste
    Range("D9").Select
End Sub

Ceci doit permettre d'affecter un cercle dans les cases "matin" de chaque jour MAIS, cela ne fonctionne que si je fais "copier" avec la souris, avant d’exécuter la Macro. Il faudrait donc rajouter cette action en début de code et je n'y arrive pas, notamment parce que ce n'est pas du texte à copier, mais un objet (cercle).
Possible ? Merci d'avance.

[Daniel.C]

Bonjour,

Utilise ce code :

Code :

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

1
2
3
4
5
Range("C9").Copy
For i = 6 To 45 Step 3
    Cells(9, i).Select
    ActiveSheet.Paste
Next i

[defluc]

Et pourquoi ne pas tout simplement affecter un caractère spécial à ces cellules ?

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
Private Sub CommandButton6_Click()  ' ENTOURER Macro
  Range("C9") = Chr(8)
  Range("F9") = Chr(8)
  Range("I9") = Chr(8)
  Range("L9") = Chr(8)
  Range("O9") = Chr(8)
  Range("R9") = Chr(8)
  Range("U9") = Chr(8)
  Range("X9") = Chr(8)
  Range("AA9") = Chr(8)
  Range("AD9") = Chr(8)
  Range("AG9") = Chr(8)
  Range("AJ9") = Chr(8)
  Range("AM9") = Chr(8)
  Range("AP9") = Chr(8)
  Range("AS9") = Chr(8)
  Range("D9") = Chr(8)
End Sub

[pit22]

Bonjour,
Daniel, lorsque je colle ton code au début du mien, il ne se passe rien.
Defluc, cela me rempli les cases avec des caractère spéciaux, ce n'est pas ce que je demande, il faut que les cases soient entourées, comme dans la ligne exemple (ce que mon bouton noir fait d'ailleurs, dans la mesure ou je selectionne le cercle en b7 par exemple, puis clic droit copier).
GRRR, j'aimerai bien vous envoyer ce fichier, ça fait 30 min que j'essai mais il est trop volumineux : 14 M, (y'a pas un site ou je peux le déposer ou vous pourriez le consulter si besoin).

[defluc]

https://www.dropbox.com/

[Daniel.C]

Bonjour,

Mon code remplace le tien. Regarde le classeur joint; appuie sur le bouton.

[pit22]

ca fonctionne ton code, mais alors chose étrange, impossible de faire disparaitre les ronds que ton code colle, avec mon deuxième bouton de commande (qui fonctionne avec mon ancien code) Etonnant. Il reste encore une petite chose a corriger donc. Je vais essayer de comprendre comment fonctionne la drop box pour vous transmettre le fichier, je pense que ce serait plus parlant.En tout cas merci beaucoup pour cette aide déja precieuse, j'aurais jamais réussit à faire cela.

[patricktoulon]

Bonjour
on pourrait essayer de travailler la methode

un exemple

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
 
Sub met_des_rond_partout()
Dim listrange As Variant
listrange = Array("C9", "F9", "I9", "L9", "O9", "R9", "U9", "X9", "AA9", "AD9" _
, "AG9", "AJ9", "AM9", "AP9", "AS9")
 
   For i = 0 To UBound(listrange)
   Set cel = Range(listrange(i))
    With Worksheets("Feuil1").Shapes.AddShape(msoShapeOval, cel.Left, cel.Top, cel.Width, cel.Height):  End With
   Next
End Sub

@daniel """select +paste"" allons!!? ca n'est pas toi ca ?
Au plaisir

[Daniel.C]

Bonsoir,

Pour effacer :

Code :

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

1
2
3
4
5
6
7
8
9
10
    Dim Sh As Shape
    For Each Sh In ActiveSheet.Shapes
        With Sh.TopLeftCell
            If .Row = 9 Then
                If .Column Mod 3 = 0 And .Column > 2 And .Column <= 45 Then
                    Sh.Delete
                End If
            End If
        End With
    Next Sh