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

[Daniel.C]

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

Bonsoir Patrick,

Je ne le ferai plus; promis. C'était pour ne pas déstabiliser le demandeur

[patricktoulon]

re

ne fais pas de promesse que tu ne pourrais pas
tenir

tu crois qu'il saura reunir les deux fonction (effacer: placerles cercles)?

Au plaisir

[pit22]

j essai debut de semaine. Je vais essayer de comprendre le nouveau code + l essai de déstabilisation. Merci merci, je pense cela fantastique cette aide avec votre expertise.

[pit22]

Bonjour Daniel, Defluc, Patrick,

Alors j'ai pas compris le test du copier coller je ne sais quoi.
Pour les nouveaux codes, je les ai essayé. Ca fait toujours pareil, ca n'efface les cercles que quand c'est moi qui les copie colle manuellement, et pas quand ils sont collés avec la macro (et c'est pareil avec les deux différentes marcos) MAIS, je me suis rendu compte que quand j'éxecute la macro pour mettre les cercles, puis que manuellement je les rétréci un peu dans la cellule, alors en exécutant la macro pour faire disparaitre les cercles, ça fonctionne. Mais comme je n'y connais rien, je peux pas modifier le code pour faire d'autres essais.

PS, pas de problème pour cloturer le post dès que l'on aura fini, ou seront mort d'épuisement.
Merci

[Daniel.C]

Mets un classeur exemple en pièce jointe.

[pit22]

http://sendbox.fr/pro/mhmfblpq2nsw/P...ssai).xls.html

Victoire (pour la pièce jointe je parle). Vous allez enfin voir la dure et vraie réalité:cool: Ca fonctionne, j'ai testé, même si le site de telechargement dis que le lien sera disponible après 24h d'attente, cela fonctionne de suite.
----------------------------
Donc tous les boutons de commande avant le bouton noir avaient été assignés à la mise en place de croix, mais ce n'est finalement pas ce que je souhaite faire (mais plustôt ces fameux ronds), c'est donc la ligne 9 qui nous interesse, et il faudra que je fasse cela pour toutes les lignes ensuite. Si l'on copie colle le cercle de la case b7 par exemple, dans une des cases qui nous interesse (c9,f9,i9...) et que l'on appui sur le bonton de commande d'effacement (celui précédant le bouton noir), cela efface les ronds. Si l'on utilise le bonton noir, ce sont bien les mêmes ronds qui se mettent en place automatiquement (grace à votre code), mais ils ne s'effacent plus avec la commande.
----------------------------
Utilité : Ce document va etre pré-rempli avec les ronds par un infirmier, pour préciser les soins qui devront etre effectués par les soignants pour chaque personne agée en maison de retraite, puis les soignants feront une croix à l'interieur (sur la version imprimée du document pré-rempli), quand ils auront effectué le soin : outil de tracabilité donc.

Merci encore de ton aide.

[patricktoulon]

Bonjour
purée de purée de zut , c'est quoi ton fichier
1 er default: 14 mega Ya quoi dedans
2 eme defaut: comme je l'ai indiqué a Daniel les select et activâtes et autre paste font ramer la bécane il te confirmera tout ce que je dis
je vais m'arrêter la je vais l'ouvrir avec les macro bloquée sinon il met 2 heures a s'ouvrir

je vais entièrement le reprendre histoire de te montrer comment en faisant attention a la méthode on peut l'alléger et le rendre plus fonctionnel

un exemple d'erreur a ne pas faire :
ta macro cochercase tu met

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
Sub cochercase()
'
' cochercase Macro
'
 
Range("C4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("O4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("R4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("U4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("X4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("AA4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("AD4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("AG4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("AJ4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("AM4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("AP4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("AS4").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("D4").Select
End Sub

alors que tu peut faire tout simplement

Code :

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

1
2
3
Sub cochercase()
Range("C4", "F4", "I4", "L4", "O4", "R4", "U4", "X4", "AA4", "AD4", "AG4", "AG4", "AJ4", "AM4", "AP4","AS4") = "X"
end sub

on évite ainsi la mise en mémoire vive de toute les propriété de la cellule lorsqu'on la sélectionne
je reviens plus tard
Au plaisir

[patricktoulon]

Bonjour

voila j'ai été obligé de tout le refaire car j'ai trouvé pourquoi il faisait 14 méga ton fichier
en fait au départ ca devais être un xlm(2007) et tu l'a sauvegarder en xls(2003)

quand on l'ouvre avec winrar on se rend bien compte que les propriétés ne correspondent pas avec un xls

donc voila il fonctionne complètement différent maintenant

en premier lieu pourquoi mettre un bouton pour chaque ligne(ceci éliminé)

j'ai donc mis 2 boutons pour mettre les croix et les enlever

j'ai mis aussi 2 boutons pour les cercles et les enlever
et c'est tout
je n'est pas repris tout les boutons car il y en avait qui n'avaient pas encore de fonctions je ne m'en suis donc pas occupé

le principe de fonctionnement :

tu sélectionne a main levée une ligne et la cellule en colonne "A" de cette ligne ce met en rouge pour te donner un visuel plus pratique
les 2 boutons pour les croix et enlever croix descende jusqu'à cette ligne
il ne te reste plus qu'a cliquer sur le bouton souhaité et les croix se mettent en place sur la ligne sélectionnée

j'ai paramétré aussi l'impression sur 2 pages au propre car c'était pas ca au départ
c'est beau la vie non?
résultat ton fichier ne fait plus que 81 kilo a la place de 14 méga
prend le fichier joint


e suis en train de suivre une autre piste avec des menu contextuels perso pour les cellules juste pour le fun

je te montrerais

Au plaisir

[patricktoulon]

re bonjour

voila un exemplaire avec a la place des boutons un menu contextuel au click droit sur la ligne

je te laisse decouvrir les deux options

fichier joint


au plaisir

[pit22]

Waahoooo. C'est géant ça. Je n'avais jamais vu (savais même pas que ça existait).
CRO cool.
Donc la version avec le menu contextuel me va bien, reste un détail sur les deux tableaux : les ronds sont pleins ET au premier plan (t'as changé mes ronds quoi ).

En fait donc, l'infirmier va remplir avec des ronds grace à tes macros, puis, imprimer le document et les Soignants vont fair des croix dans les ronds (donc ils fauit qu'ils soient vides c'est mieux visuellement), puis, parfois, il peut également mettre certaines croix dans les ronds directement sur informatique lorsque c'est luii même qui fait le soin, mais la, on ne voit pas la croix car le rond est plein et au premier rang (il la cache donc).
Je sais pas si c'est compliqué, c'est déja énorme ce que tu as fait avec ce gros fichier de 14M.., mais ce serait parfait.
Dis, quand je serais grand, tu m'apprendras tout ça ?

PS les croix il les met en direct avec la souris, y'a rien à changer à part mettre des ronds vides.

[patricktoulon]

ok donc les rond vides
essaie celui la
clique sur un rond avec le clic gauche quand tu a a mis une bande juste pour le fun

je m'amuse comme un fou avec ton truc
au plaisir