Macro excel

Blueberry-60

XLDnaute Nouveau
Bonjour à tous.

Je cherche à écrire une macro (execution simple clique, résultat caractère ü en police windings) pour pointage des patients de notre hôpital afin de faciliter la tâche aux membres du personnel.
B3 AF38

pouvez-vous me donne la marche à suivre pour autoriser les macros (VBA il me semble) uniquement sur ce classeur comportant plusieurs pages ? Je pense l'avoir fait mais j'ai un doute.

Explication du tableau et de ce que je recherche :
Le tableau : pour l'instant j'ai un tableau excel basique avec des dates et un total mis en lignes d'une part. D'autre part j'ai des noms triés par ordre alphabétique et une moyenne en colonne. J'ai une ligne colorée en verte puis une autre blanche (par défaut). J'ai des formules pour le total (=SOMME) et d'autres pour la moyenne (=MOYENNE). J'ai également inséré un symbole (la coche) au tableau auquel je vais affecter la macro recherchée pour l'activation/désactivation. Les cases à remplir sont de B3 à AF38 et sont en police wingdings. Et quelques cases dans la colonne A permettant d'ajouter des noms.
Le résultat final que je recherche est que lorsque je 'simple clic gauche' sur le symbole 'coche' puis sur telle ou telle case puis sur une autre case ainsi de suite (cases comprises entre B3 et AF38) cela y inscrive le caractère ü en police windings (correspond à une coche) tout en ayant une valeur réelle de 1 (pour que mes formules somme et moyenne puissent fonctionner). Je voudrai bien entendu "ressortir" de la sélection de la cellule. Puis en rappuyant sur le symbole 'coche' que ça stop (et non pas efface) toutes ces actions et que je puisse tout simplement selectionner une cellule sans autre chose.
Je voudrai également que lorsque je clique droit (toujours en ayant au préalable cliqué sur le symbole 'coche') cela supprime le contenu de la cellule (en cas d'erreur).
Je cherche également à ce que mes lignes ?? à ?? se trient par ordre alphabétique lors de l'ouverture du fichier excel (il faut que les caractères de la ligne entière suivent le tri par ordre alphabétique mais pas les couleurs qui doivent rester une verte une neutre, une verte une neutre, ...).

Petit résumé maintenant que vous avez les données en tête :

1- activation macro pour le fichier excel uniquement
2- macro activée par clique gauche sur le symbole affectée à la macro ayant deux actions différentes :
a/ clic gauche = affichage d'une coche ayant pour valeur réelle 1 sur chaque cellule selectionnée
b/ clic droit = suppression des caractères de la cellule
3.1- désactivation de la macro sans effacer les caractères précedemment insérés par clique gauche (ou droit) sur le symbole coche affecté à la macro
OU
3.2- désactivation de la macro par clic gauche sur un autre symbole style X que j'insérerai.
4- macro tri par ordre alphabétique à l'ouverture du fichier.

Merci de bien vouloir corriger les erreurs que j'ai peut-être faites afin de pouvoir accueillir vos macros.
Et surtout merci d'avance pour l'aide apportée. Sachez que vous allez faire gagner environ 5mn par jour à des infirmières qui courrent toute la journée et permettre à une infirmière très nulle en informatique de pointer ses patients sur un ordinateur en toute simplicité !

Cordialement, un collégue qui souhaite faire gagner du temps grâce à vous aux infirmières de son service voir peut-être même à un hôpital entier.
 

Pièces jointes

  • Emargement OM à envoyer.xlsm
    18.9 KB · Affichages: 26
Dernière édition:

Blueberry-60

XLDnaute Nouveau
Question bête mais comment j'enregistre la macro une fois sur l'éditeur de macro ? Je vois bien l'icône pour enregistrer mais ça m'enregistre le fichier entier et je ne retrouve pas ma macro une fois la manip faite dans la liste de macro.

Et si je veux bien un nombre entier qui correspond au total de toutes les coches mises dans la zone à remplir pour chaque colonne j'obtiens donc bien
=NB.SI(B3:B38;CAR(80)) ??
 

David.TS

XLDnaute Nouveau
En résumé, et pour compléter le code de gosselien, j'utiliserai le code suivant dans le code de la feuille JANVIER :

VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.ScreenUpdating = False

If Not Intersect(Target, Me.Range("B3:AF38")) Is Nothing Then
   If IsEmpty(Target) Then
      Target.Value = Chr(80)
   Else
      Target.Value = ""
   End If
End If

Range("A1").Select

End Sub

avec la police Windings2 ou bien

VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.ScreenUpdating = False

If Not Intersect(Target, Me.Range("B3:AF38")) Is Nothing Then
   If IsEmpty(Target) Then
      Target.Value = Chr(252)
   Else
      Target.Value = ""
   End If
End If

Range("A1").Select

End Sub

avec le police Windings
 

David.TS

XLDnaute Nouveau
La macro est enregistrée dans un module et non dans le code de la feuille. La liste des modules se trouve dans la section "Modules". S'ils n'apparaissent pas, dans l'éditeur : Menu Affichage > Explorateur de projets ou le raccourcis CTRL + R.

Ce qui devrait donner ceci :

Capture.png
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Seules apparaissent dans la liste des macro exécutables les Sub dépourvues de paramètre obligatoire, écrites dans des modules standard et Public.
Exclus donc les Private, celles écrites dans des modules objets et les munies de paramètres obligatoires.
 

David.TS

XLDnaute Nouveau
Ce code permet un tri à l'ouverture tout en gardant l'alternance des couleurs du tableau. Il est à placer dans le code du classeur en double-cliquant sur "Thisworkbook" dans l'explorateur de projet de l'éditeur.

VB:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("JANVIER").Activate
Range("B3:AF35").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$3:$AF$35"), , xlYes).Name = _
        "Tableau7"
    Range("Tableau7[#All]").Select
    ActiveSheet.ListObjects("Tableau7").TableStyle = "TableStyleMedium4"
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Feuil2").ListObjects("Tableau7").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Feuil2").ListObjects("Tableau7").Sort.SortFields. _
        Add Key:=Range("Tableau7[HJ OM]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil2").ListObjects("Tableau7").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Range("A1").Select
End Sub

Pour modifier le style
 
Dernière édition:

David.TS

XLDnaute Nouveau
Pour changer de style, il suffit d'éditer la ligne :

ActiveSheet.ListObjects("Tableau7").TableStyle = "TableStyleMedium4"

en changeant "TableStyleMedium4" par "TableStyleLight[1 à 21]" , "TableStyleMedium[1 à 28]" , "TableStyleDark[1 à 11]" correspondant au tableaux prédéfinis dans Excel (ici Excel 2013 mais sensiblement identique dans Excel 2010), de la commande "Mettre sous forme de tableau" de l'onglet "Accueil".
 

Discussions similaires

Statistiques des forums

Discussions
314 629
Messages
2 111 351
Membres
111 111
dernier inscrit
houndemint