Affichage text box lors d'un clic sur une cellule

Caribou

XLDnaute Nouveau
Bonjour à tous,

jusqu'à présent j'utilisais la validation de données pour afficher des messages contextuels lors de la sélection d'une cellule.

Malheureusement, le nombre de caractères est limité.

Est-il possible de faire apparaître un texte paramétrable (couleur police et couleur fond) d'une taille libre (s'ajustant au contenu) lors de la sélection d'une cellule et qui disparaît lors de la sélection d'une autre cellule ? Et si oui, comment bien sûr ?

Les solutions "commentaire" ou msgbox ne conviennent pas car je veux pouvoir paramétrer couleurs de police et de fond et ne pas avoir de boîte à fermer.

Je cherche vraiment à obtenir l'effet du message que l'on peut avoir avec la validation des données, le paramétrage des couleurs en plus.

Merci pour votre aide
 

Pièces jointes

  • Book1.xlsx
    7.7 KB · Affichages: 65
  • Book1.xlsx
    7.7 KB · Affichages: 73
  • Book1.xlsx
    7.7 KB · Affichages: 65

PMO2

XLDnaute Accro
Re : Affichage text box lors d'un clic sur une cellule

Bonjour,

Une piste en VBA.
1) Copiez le code suivant dans un module Standard
Code:
'### Constantes à adapter ###
'/// le n° de colonne sur laquelle agit Worksheet_SelectionChange ///
Public Const NUM_COLONNE As Long = 1
'/// le nom de la feuille sur laquelle sont indiquées les infos ///
Private Const FEUILLE_INFOS As String = "infos"
'############################

Public TempoPicture As Shape

Sub ProcInfos(R As Range)
Dim S As Worksheet
Dim R2 As Range
Dim j&
Dim var
Dim bool
'---
If R.Cells.Count > 1 Then Exit Sub
If R = "" Then Exit Sub
'--- Source (copie) ---
Set S = Sheets(FEUILLE_INFOS)
var = S.Range(S.Cells(1, 1), S.Cells(1, S.[a1].End(xlToRight).Column))
For j& = 1 To UBound(var, 2)
  If UCase(R) = UCase(var(1, j&)) Then
    Set R2 = S.Range(S.Cells(2, j&), S.Cells(2, j&))
    Set R2 = S.Range(S.Cells(2, j&), S.Cells(R2.End(xlDown).Row, j&))
    bool = True
    Exit For
  End If
Next j&
If Not bool Then Exit Sub 'aucune correspondance n'a été trouvée, on sort.
'---
R2.CopyPicture
'--- Destination (collage) ---
Set S = R.Parent
Application.EnableEvents = False
R.Offset(0, 1).PasteSpecial
Set TempoPicture = S.Shapes(S.Shapes.Count)
R.Select
Application.EnableEvents = True
End Sub

2) Copiez le code suivant dans la fenêtre de code de la feuille concernée
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not TempoPicture Is Nothing Then
  TempoPicture.Delete
  Set TempoPicture = Nothing
End If
If Target.Column = NUM_COLONNE Then
  Call ProcInfos(Target)
End If
End Sub

Adaptez les constantes cernées par des ###

La feuille "infos" doit être renseignée à partir de A1
La ligne 1 contient les valeurs qui seront recherchées, les autres lignes sont les infos proprement dites.
Les différentes occurrences sont par colonne.
Toute la mise en forme sera réalisée dans cette feuille. Vous pouvez masquer cette feuille (xlVeyHidden) sans qu'il n'y ait d'interférence sur le fonctionnement du programme (tout du moins chez moi).
 

Discussions similaires

Statistiques des forums

Discussions
312 330
Messages
2 087 343
Membres
103 525
dernier inscrit
gbaipc