Modifier images dans feuilXl par clic de souris (Excel2003)
Bonjour, étant un éternel amateur ce problème m'a permis de comprendre beaucoup sur la programmation VBA, grâce surtout à votre site !
Je voudrais en créant des évènements (clics-souris) sur une image dans une feuille excel, modifier cette image.
Mais alors que je peux le faire sur des objets Chart, je vois que ce n'est pas possible directement sur des images.
j 'arrive bien à selectionner ces images nommées "objPic", les filtrer avec "If ObjPict.Type = msoPicture Then"
Mais impossible de les inclure dans une collection pour agir dessus avec des événements.
j 'ai un message : "cet objet ne gère pas d'événements Automation".
j 'ai essayé de nombreuses déclarations, vu que je n'y connais pas grand chose du style :
Dim ObjPict As Shape, mais aussi,Image, Shape, OLEObject, PictureFormat, Frame, object, aussi pour Public WithEvents ObjPict As Shape.
Là c 'était les observations sur mon humble travail,
voici quelques questions ! :
Déjà, est-il possible de corriger mes erreurs grossières ? !
Est-il possible lors du clic sur une image de créer une forme (style outil/sélection, outil/recadrer des softs de traitement d'image) ?
j 'ai survolé la biblio "Le module de classe clGdiPlus" mais comme je veux quelque chose de simple et de plus l'adapter pour word, je ne voudrais pas faire fausse route. Est-ce une classe obligatoire pour ce que je veux faire ?
Je ne doute pas que vous êtes nombreux à avoir toutes les connaissances requises pour régler mon problème !
Alors n 'hésitez pas à me faire part de vos corrections et idées pour que je progresse.
Merci jacques ...
Voici pour illustrer les lignes de code
dans thisworbook j'ai mis :
Code:
1
2
3
4
5
| Option Explicit
Private Sub Workbook_Open()
InitObjetImage 'pour ClassPict
End Sub |
dans un module standard j'ai mis :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
| Option Explicit '
Option Compare Text
Public CollectPict As Collection 'declaration de la collection '''''''''
Sub InitObjetImage() 'routine initialisation lors de l'ouverture par le code de ThisWorkook
Dim ObjPict As Shape
Dim ClPict As ClassPict
Set ClPict = Nothing
Set CollectPict = New Collection
Workbooks("ClasrEventsGraphCoordImgSoft.xls").Activate
For Each ObjPict In Worksheets(1).Shapes
If ObjPict.Type = msoPicture Then
Set ClPict = New ClassPict
Set ClPict.ObjPict = ObjPict.Shape 'j'ai pas trouvé la bonne écriture
CollectPict.Add ClPict
End If
Next ObjPict
End Sub |
Dans le module de classe "ClassPict" :
Code:
1
2
3
4
5
6
7
8
9
10
| Public WithEvents ObjPict As Shape 'Image Shape OLEObject PictureFormat Frame object
'avec essai 15: Un objet ne gère pas d'événements Automation
Private Sub ObjPict_Click()
'mon code ici pour récupérer les coordonnées
MsgBox ObjPict.name & ": " & ObjPict.Value 'juste pour essai
End Sub |
dans un module de classe "Classevenements" voici le début du code qui me permet de récupérer les coordonnées pour ensuite orienter vers la bonne routine avec une suite d'instructions "case"
Ce code ne fonctionne que si je remplace "Private Sub ObjPict_MouseMove(ByVal Button As..." par
"Private Sub Chart_MouseMove(ByVal Button As..." Il permet de mettre dans un tableau
la difference entre deux clics de souris et de l'afficher.
'code:
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
| Option Explicit
Public diffx As Integer
Public diffy As Integer
Public x1 As Integer
Public y1 As Integer
Public x2 As Integer
Public y2 As Integer
Public WithEvents ObjPict As shape 'l'objet n'est pas source d'evenement d'automation
Private Sub ObjPict_MouseMove(ByVal Button As Long, ByVal Shift As Long, _
ByVal x As Long, ByVal y As Long)
' Dim ElementID As Long
Dim Arg1 As Long, Arg2 As Long
' If ActiveChart.Name = "Feuil1 Chart 2" Then
Range("b12") = Button & " / " & Shift & " / " & x & " / " & y
Range("b7") = x
Range("b8") = y
' End If
End Sub
Private Sub ObjPict_Mousedown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim i As Integer, j As Integer
Static Nbc As Long
Nbc = Nbc + 1
Static vartab() As String
ReDim Preserve vartab(2, 1 To Nbc) As String
Range("b13") = Button & " / " & Shift & " / x : " & x & " / y : " & y & " / Nbc : " & Nbc
vartab(1, Nbc) = x
vartab(2, Nbc) = y
Dim NbcReste As Long
NbcReste = Nbc Mod 2
'export x1 et y1 , x2 et y2
If NbcReste > 0 Then
x1 = x
y1 = y
Range("b14") = Button & " / " & Shift & " / x1 : " & x1 & " / y1 : " & y1 & " / Nbc : " & Nbc
Else
x2 = x
y2 = y
Range("b15") = Button & " / " & Shift & " / x2 : " & x2 & " / y2 : " & y2 & " / Nbc : " & Nbc
End If
If NbcReste = 0 Then
' For i = 1 To Nbc - 1 Step 2 ok pas de msgbox mais go to Recherche_instruction_x
For i = 1 To Nbc Step 2
diffx = vartab(1, i) - vartab(1, i + 1)
diffy = vartab(2, i) - vartab(2, i + 1)
' MsgBox "Variation x : " & diffx & vbCrLf & "Variation y : " & diffy
Next i
End If
If NbcReste = 0 Then
Recherche_instruction_1A400_x
Recherche_instruction_1A400_y
Recherche_instruction_401A800_x
Recherche_instruction_401A800_y
End If
End Sub
Sub Recherche_instruction_1A400_x()
Select Case Abs(diffx)
Case "1": MsgBox "Case ""1"" diffx = " & diffx & " ; x1 : " & x1 & " ; x2 : " & x2
Case "2": MsgBox "Case ""2"" diffx = " & diffx & " ; x1 : " & x1 & " ; x2 : " & x2
Case "3": MsgBox "Case ""3"" diffx = " & diffx & " ; x1 : " & x1 & " ; x2 : " & x2
etc... |
