[VBA-Excel] Changement du curseur de ma souris

Version imprimable

30/08/2006, 16h49
marsupilami34

[VBA-Excel] Changement du curseur de ma souris

Bonjour,

Je souhaiterai, lorsque le curseur de ma souris se trouve sur un Label, le changer, le faire passer comme ceci

J'utilise la propriété MouseMove, mais j'aimerai lui associé ce curseur.

Merci d'avance
30/08/2006, 16h50
marsupilami34

1 pièce(s) jointe(s)

Désolé, problème de chargement de mon curseur, le voici
30/08/2006, 16h58
SfJ5Rpw8

voir propriété MousePointer du label .. à placer à 99 , et le lien vers fichier icone dans propriété MouseIcon
30/08/2006, 17h04
marsupilami34

Citation:

Envoyé par bbil

le lien vers fichier icone dans propriété MouseIcon

Le truc c'est que je ne sais pas ou ce trouve l'icone et quelle extension il doit avoir.

L'image que j'ai fait parvenir était un print écran
30/08/2006, 17h11
SfJ5Rpw8
Tiens voila ...
Code:

1 2 3 4 5 Private Sub UserForm_Initialize() Label1.MouseIcon = LoadPicture("c:\windows\cursors\HARROW.CUR") Label1.MousePointer = fmMousePointerCustom End Sub
aprés je sais pas si fichier toujours la .. pour le chemin de windows on peu utiliser environ("SystemRoot") .. mais pour le sous-répertoire cursors..
30/08/2006, 17h13
marsupilami34

Merci, je vais tester

A adapter pour VBA... :

Code:

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
39
Option Explicit
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
Private Declare Function GetCursor Lib "user32" () As Long
Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Const OCR_NORMAL As Long = 32512
Private curseurpresent As Long
Private iconcurseurpresent As Long
 
Private Sub Command1_Click()
  '===================je récupère d'abord (pour pouvoir au besoin le restituer) le curseur en cours
  curseurpresent = GetCursor()
  iconcurseurpresent = CopyIcon(curseurpresent)
  '=================================================================
  Dim myDir As String
  Dim lDir As Long
  myDir = Space(255)
  lDir = GetWindowsDirectory(myDir, 255)
  myDir = Left$(myDir, lDir) & "\cursors\"
  CommonDialog1.InitDir = myDir
  CommonDialog1.ShowOpen
  definitcurseur CommonDialog1.filename
End Sub
 
Private Sub Form_Activate()
  Command1.Caption = "choisir un curseur"
End Sub
 
Sub definitcurseur(lefic)
  Dim lecurseur As Long
  lecurseur = LoadCursorFromFile(lefic)
  Call SetSystemCursor(lecurseur, OCR_NORMAL)
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  '========= je restitue le curseur tel qu'il était
  Call SetSystemCursor(iconcurseurpresent, OCR_NORMAL)
End Sub

en signalant que le curseur que veut notre ami a pour nom : harrow.cur

Il peut donc, bien évidemment éviter le commondialog et faire directement ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Command1_Click()
  '===================je récupère d'abord (pour pouvoir au besoin le restitier) le curseur en cours
  curseurpresent = GetCursor()
  iconcurseurpresent = CopyIcon(curseurpresent)
  '=================================================================
  Dim myDir As String
  Dim lDir As Long
  myDir = Space(255)
  lDir = GetWindowsDirectory(myDir, 255)
  myDir = Left$(myDir, lDir) & "\cursors\"
  definitcurseur myDir & "harrow.cur"
End Sub

S'veut de surcroit des petites chatouille (main qui bouge), il remplace, à sa guise, harrow.cur par handapst.ani ou par handno.ani
Qu'il essaye ...:D

30/08/2006, 23h39
SfJ5Rpw8

Bonsoir jmf..

Citation:

Envoyé par jmfmarques

A adapter pour VBA... :

..

eu l'adaptation pour VBA elle est la, nul besoin d'API. ;)
31/08/2006, 00h16
zazaraignée

Hmmm!

Hé bé! API beurre dé tout y ou, jmf!
31/08/2006, 00h21
SfJ5Rpw8

Citation:

Envoyé par zazaraignée

Hmmm!

Hé bé! API beurre dé tout y ou, jmf!

c'est pas du language SMS ça ..? 8O

(la je suis sur que c'est pas de l'espagnol..)
31/08/2006, 07h11
jmfmarques

Citation:

Envoyé par zazaraignée

Hmmm!

Hé bé! API beurre dé tout y ou, jmf!

Bonjour zaza,

Relis, su tu parviens à les retrouver, les 2 ou 3 messages où j'ai eu l'occasion d'exposer comment je distribuais certains exe, une fois l'application arrêtée définitivement en VB.... et tu comprendras tout..

En résumé :
1) appli en VB pour ne pas "jouer à la bataille navale"
2) arrêt définitif de l'appli
3) transposition en QBasic ou en RapidQ, selon le cas pour gagner en rapidité d'exécution et en indépendance totale
4) distribution d'un exe qui n'a nul besoin d'un empaquettage.

Il est clair qu'à ce jeu-là, les facilités offertes par VB passent aux oubliettes pour céder la place aux APIs de Windows. ;)

J'ai commencé avant-hier un outil pour APIs et j'avance lentement mais surement.
Description de la fonction - syntaxe de la déclaration - exemple simple d'utilisation.
Le tout en fichier hlp.
Ce sera mon cadeau de départ
31/08/2006, 08h28
SfJ5Rpw8

Citation:

Envoyé par jmfmarques

...
S'veut de surcroit des petites chatouille (main qui bouge), il remplace, à sa guise, harrow.cur par handapst.ani ou par handno.ani
Qu'il essaye ...:D

finalement pour des curseurs animé.. ( ce n'est pas le cas dans cette discussion) l'utilisation d'API semble s'imposer LoadPicture ne voulant pas entendre parler de .ani..