Macro excel

Blueberry-60 · 24 Juillet 2017

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.

David.TS · 27 Juillet 2017

Je précise toutefois, le fait de double-cliquer sur une cellule du tableau devrait faire apparaitre ou disparaitre la coche à la manière d'un interrupteur. La valeur de la cellule est testée par l'absence ou la présence de cette coche, tout simplement, qui est reprise grâce au test des cellules contenant NB.SI().

Blueberry-60 · 27 Juillet 2017

Oui jusqu'ici le pointage c'est niquel comme ca double clique pour pointer double clique pour enlever le pointage parfait pas besoin du raccourci, quand on double clique dans une autre case ça ne fait rien. Bref parfait !
Par contre je ne comprend pas ce que vous voulez dire par "pour changer de style" ?
Je compte ensuite copier la feuille janvier 11 fois et renommer chaque feuille fevrier mars avril etc. Faudra-t-il que j'adapte chaque code à chaque feuille ? Ou bien vont elles se corriger automatiquement ?

David.TS · 27 Juillet 2017

Quand je dit "Style" , il s'agit du jeu de couleurs que vous préférez pour l'apparence du tableau. C'est à dire, dans ce cas ci, les tons vert. Si vous préférez un autre jeu de couleurs et d'apparences, vous pouvez changer de "Style", comme je l'ai précisé ci-dessus.

Pour les autres feuilles que vous allez créer, attention toutefois à leur numérotation et à leur nom. Le code valable pour la feuille de "JANVIER" l'est aussi pour les autres feuilles. Par contre, dans le code du classeur (ThisWorkbook), il faut compléter le code existant. Pour l'exemple de "FEVRIER", voici un code adapté :

Dans le code de la feuille ("FEVRIER") : --- PAS DE DIFFERENCES AVEC "JANVIER" --- en supposant l'emplacement des cellules identiques (copier/coller de la feuille "JANVIER" pour créer "FEVRIER")

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)  ' >> avec la police Windings2
   Else
      Target.Value = ""
   End If
End If

Range("A1").Select

End Sub

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)  ' >> avec la police Windings
   Else
      Target.Value = ""
   End If
End If

Range("A1").Select

End Sub

PUIS, dans le code du classeur, ajouter :

VB:

Sheets("FEVRIER").Activate
Range("B3:AF35").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$3:$AF$35"), , xlYes).Name = _
        "Tableau8"  ' >>> CHANGER LA NUMÉROTATION DU TABLEAU
    Range("Tableau8[#All]").Select  ' >>> CHANGER LA NUMÉROTATION DU TABLEAU
    ActiveSheet.ListObjects("Tableau8").TableStyle = "TableStyleMedium5"  ' >>> CHANGER LA NUMÉROTATION DU TABLEAU ET LE STYLE SI DÉSIRÉ
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Feuil3").ListObjects("Tableau8").Sort.SortFields. _
        Clear  ' >>> CHANGER LE NUMÉRO DE LA FEUILLE ET LE NUMÉRO DU TABLEAU
    ActiveWorkbook.Worksheets("Feuil3").ListObjects("Tableau8").Sort.SortFields. _
        Add Key:=Range("Tableau8[HJ OM]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal  ' >>> CHANGER LE NUMÉRO DE LA FEUILLE ET LE NUMÉRO DU TABLEAU
    With ActiveWorkbook.Worksheets("Feuil3").ListObjects("Tableau8").Sort  ' >>> CHANGER LE NUMÉRO DE LA FEUILLE ET LE NUMÉRO DU TABLEAU
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With  ' >>> CHANGER LE NUMÉRO DE LA FEUILLE ET LE NUMÉRO DU TABLEAU
Sheets("JANVIER").Activate

Pour le mois de mars, il faudra encore ajouter :

VB:

Sheets("MARS").Activate
Range("B3:AF35").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$3:$AF$35"), , xlYes).Name = _
        "Tableau9"  ' >>> CHANGER LA NUMÉROTATION DU TABLEAU
    Range("Tableau9[#All]").Select  ' >>> CHANGER LA NUMÉROTATION DU TABLEAU
    ActiveSheet.ListObjects("Tableau9").TableStyle = "TableStyleMedium6"  ' >>> CHANGER LA NUMÉROTATION DU TABLEAU ET LE STYLE SI DÉSIRÉ
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Feuil4").ListObjects("Tableau9").Sort.SortFields. _
        Clear  ' >>> CHANGER LE NUMÉRO DE LA FEUILLE ET LE NUMÉRO DU TABLEAU
    ActiveWorkbook.Worksheets("Feuil4").ListObjects("Tableau9").Sort.SortFields. _
        Add Key:=Range("Tableau9[HJ OM]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal  ' >>> CHANGER LE NUMÉRO DE LA FEUILLE ET LE NUMÉRO DU TABLEAU
    With ActiveWorkbook.Worksheets("Feuil4").ListObjects("Tableau9").Sort  ' >>> CHANGER LE NUMÉRO DE LA FEUILLE ET LE NUMÉRO DU TABLEAU
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Sheets("JANVIER").Activate  ' >>> Cette ligne peut n'apparaitre qu'une seule fois pour le dernier mois. En l'occurence pour l'ajout du mois de "DECEMBRE"

...etc, etc idem pour les autres mois de l'année.

Blueberry-60 · 27 Juillet 2017

Dac tout ça me semble clair vous avez en plus anticipé ma prochaine question qui allait mettre en avant les parties du code à adapter. Je pense pouvoir finir ce projet grâce à toutes vos indications.
Merci encore de toute l'aide apportée.
Je finis le fichier et je vous dis si tout va bien. Si le fichier est vraiment bien et serait utile à d'autres services, je le présenterai à la direction et vous contacterai pour qu'une reconnaissance vous soit apportée (ne serait-ce que votre signature au moins).

Blueberry-60 · 28 Juillet 2017

Erreur d'exécution '9':
L'indice n'appartient pas à la sélection.

--> débogage = la ligne suivant est surlignée en jaune

ActiveWorkbook.Worksheets ("feuil2") .ListObjects ("Tableau7") .Sort.SortFields. _
Clear

David.TS · 28 Juillet 2017

Peu-être que L'ID de la feuille ("feuil2") ou le numéro de tableau ("Tableau7") ne correspond pas....

Blueberry-60 · 28 Juillet 2017

C'est bizarre pourtant c'est bien la feuil2 (JANVIER)
Et j'ai vu ecrit qqpart tableau 7 en effet

Macro excel

Blueberry-60

XLDnaute Nouveau

Pièces jointes

David.TS

XLDnaute Nouveau

Blueberry-60

XLDnaute Nouveau

David.TS

XLDnaute Nouveau

Blueberry-60

XLDnaute Nouveau

Blueberry-60

XLDnaute Nouveau

David.TS

XLDnaute Nouveau

Blueberry-60

XLDnaute Nouveau

Discussions similaires