Affichage de la valeur d'une cellule sur le bureau windows

[hayabusa42]

Bonjour à Tous,

J'ai un fichier qui me permet d'avoir une valeur de cellule qui varie (après actualisation successives) et je souhaiterai que cette valeur apparaisse directement sur mon bureau windows (pour ne pas être obligé de consulter en permanence le fichier Excel concerné).

En vous remerciant,
Cordialement,

Haya42

 

[Eric 45]

Re : Affichage de la valeur d'une cellule sur le bureau windows

Bonsoir à tous
Bonsoir hayabusa42 et bienvenu

Où en es tu de ton pb ?

Une question à ce sujet :
- Le fichier avec cette fameuse cellule est-il "ouvert" ?

Si tu mets ton renseignement sur le bureau, il te faudra fermer toutes les appli ouvertes .... c'est un peu pénible non ?

Je te propose ceci, si le fichier est ouvert bien sûr :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveWindow.Caption = Range("a1").Value  'à la place de a1 => la bonne cellule
End Sub

à mettre dans le fichier.

Tu nous dis

Eric

 

[PMO2]

Re : Affichage de la valeur d'une cellule sur le bureau windows

Bonjour,

Une piste avec le code suivant.

CELA FAIT
1) Crée un raccourci (icône) sur le bureau dont le nom est la valeur de la cellule concernée.
2) La valeur (nom du raccourci) est mise à jour selon un délai prédéfini qui peut être adapté.

Il vous d'abord adapter les constantes selon votre usage
'### A adapter: délai du rafraîchissement ###
Const DELAI As String = "00:00:10" '"00:00:10" = 10 secondes
'############################################

'### A adapter: nom de la feuille et adresse de la cellule concernées ###
Const FEUILLE_A_EPIER As String = "Ma feuille"
Const CELLULE_A_EPIER As String = "C1"
'########################################################################

Copiez le code ci-dessous dans un module standard

Const PREFIXE As String = "  " 'Espace OU Alt 0160 (2 fois) 'Caractère blanc ou insécable

'### A adapter: délai du rafraîchissement ###
Const DELAI As String = "00:00:10"  '"00:00:10" = 10 secondes
'############################################

'### A adapter: nom de la feuille et adresse de la cellule concernées ###
Const FEUILLE_A_EPIER As String = "Ma feuille"
Const CELLULE_A_EPIER As String = "C1"
'########################################################################

'### Ce ne sont que des chemins d'icônes ###
Const ICO1 As String = "C:\Program Files\Microsoft Visual Studio\COMMON\Graphics\Icons\Misc\EYE.ICO"
Const ICO2 As String = "C:\Program Files\Microsoft Office\OFFICE11\FORMS\1036\POSTITL.ico"
'###########################################

Dim StopOnTime As Boolean

Sub Stopper()
StopOnTime = True
End Sub

Sub Lancer()
StopOnTime = False
Call ValeurSurBureau
End Sub

Sub ValeurSurBureau(Optional dummy As Byte)
'/// Library IWshRuntimeLibrary       /// Référence pour liaison précoce
'/// C:\WINDOWS\system32\wshom.ocx    ///
'/// Windows Script Host Object Model ///

Dim WS As Object            'IWshRuntimeLibrary.WshShell
Dim SC As Object            'IWshRuntimeLibrary.WshShortcut
Dim fso As Object           'IWshRuntimeLibrary.FileSystemObject
Dim SourceFolder As Object  'IWshRuntimeLibrary.Folder
Dim FileItem As Object      'IWshRuntimeLibrary.File
Dim WB As Workbook
Dim Bureau$
Dim bool As Boolean
Set WS = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(WS.SpecialFolders("Desktop"))
  '--- Met à jour le raccourci ---
For Each FileItem In SourceFolder.Files
  If FileItem.Type = "Raccourci" Then
    If Left(FileItem.Name, 2) = PREFIXE Then
      Application.ScreenUpdating = False
      Set WB = ActiveWorkbook
      ThisWorkbook.Activate
      On Error Resume Next
      FileItem.Name = PREFIXE & _
          Sheets(FEUILLE_A_EPIER).Range(CELLULE_A_EPIER).Value & ".lnk"
      On Error GoTo 0
      WB.Activate
      Application.ScreenUpdating = True
      bool = True
      Exit For
    End If
  End If
Next FileItem
  '--- Si raccourci n'existe pas, on le crée ---
If Not bool Then
  Bureau$ = WS.SpecialFolders("Desktop")
  Set SC = WS.CreateShortcut(Bureau$ & "\" & PREFIXE & _
      Sheets(FEUILLE_A_EPIER).Range(CELLULE_A_EPIER).Value & ".lnk")
  With SC
    If fso.FileExists(ICO1) Then
      .IconLocation = ICO1
    Else
      .IconLocation = ICO2
    End If
    .TargetPath = vbNullChar
    .Description = vbNullString
    .WorkingDirectory = Bureau$
    .Save
  End With
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing
Set SC = Nothing
Set WS = Nothing
    '--- Pour relancer toutes les x secondes ---
If Not StopOnTime Then Application.OnTime Now + TimeValue(DELAI), "ValeurSurBureau"
End Sub

Pour activer le programme faites tourner la macro "Lancer".
La macro "Stopper" arrète le OnTime ce qui a pour effet de ne plus rappeler la macro "ValeurSurBureau"
Le contenu de la cellule à épier peut être une valeur ( par exemple "Bonjour" ), une formule, une référence à un autre classeur
( par exemple =[test.xls]Feuil1!$E$2 )
La fenêtre du classeur peut être minimisée, un autre classeur peut être chargé.

Bon courage.

Cordialement.

PMO
Patrick Morange

 

[Eric 45]

Re : Affichage de la valeur d'une cellule sur le bureau windows

Bonjour à tous
Bonjour Patrick

Très bonne astuce.

Si je peux me permettre une toute petite amélioration (que je n'ai pas trouvée), l'icône se replace à une position sur le bureau qui n'intéresse pas forcément. Il se recrée à chaque relance, dommage.

Pour éviter le rafraîchissement toutes les x secondes, on peut placer ce code dans :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call ValeurSurBureau
End Sub

Merci pour ce code, je l'engrange dans ma valise.

Eric

 

[hayabusa42]

Re : Affichage de la valeur d'une cellule sur le bureau windows

Bonjour à Tous,

PARFAIT....c'est exactement ce qu'il ma fallait !
Merci beaucoup

Hayabusa42