Discussion :

[Jacdan]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Option Explicit
 
Private Sub Workbook_Open()
 InitObjetImage 'pour ClassPict
End Sub

dans un module standard j'ai mis :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[ouskel'n'or]

Désolé mais je ne me suis pas plongé dans ton code... Tu as expérimenté des "trucs" que je ne connais/comprends pas en première "examen de surface"
Par contre, en tant que Shapes, tout dépends des modifications que tu souhaites réaliser. Tu pourras redimensionner tes images, les tronquer à droite ou as gauche, en haut ou en bas, mais tes objets ne sont plus des Images.
Regarde à ShapeRange - Collection et propriété - dans l'aide en ligne.
Regarde également les propriété de l'objet PictureFormat, CropRight/Left/Top...
Tout ça si tu ne souhaites que redimentionner tes images. Pour les modifier c'est une toute autre histoire
Bonne journée

[fring]

Bonjour Jacdan, Ousk

Pour répondre à la question initiale concernant l'événement Click, une image insérée telle quelle n'accepte pas de procédure événementielle (ça tu l'as constaté).

Passe par un contrôle "Image" du menu "Boîte à outils contrôles", sur lequel tu insères ton image. Ce contrôle accepte les événements.

Petit exemple de base pour insérer ce contrôle et y coller une image

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
Dim ObjImg As OLEObject, ObjPos As Range
 
'définition d'une plage de cellules pour
'positionnement et dimensionnement du contrôle image
'par rapport à cette plage
Set ObjPos = Sheets(1).Range("B5:D18")
 
'insertion d'un contrôle image
Set ObjImg = Sheets(1).OLEObjects.Add(ClassType:="Forms.Image.1")
 
'quelques uns des paramètres du contrôle image
With ObjImg
    .Name = "Img1" '<-- nom du contrôle (facultatif mais plus facile à retrouver si tu les nommes)
    .Top = ObjPos.Top '<-- position verticale
    .Left = ObjPos.Left '<-- position horizontale
    .Height = ObjPos.Height '<-- hauteur
    .Width = ObjPos.Width '<-- largeur
    .Object.Picture = LoadPicture("D:\My documents\My Pictures\MonImage.jpg") '<-- insertion de l'image
    'PictureSizeMode = taille de l'image :
    '0 = taille originale
    '1 = strech de l'image à la taille du contrôle
    '2 = ajustement de l'image à la taille du contrôle tout en gardant les proportions originales
    .Object.PictureSizeMode = 1
End With
 
'libération de la mémoire
Set ObjPos = Nothing
Set ObjImg = Nothing
 
End Sub

[Jacdan]

Merci Ousk et Fring, je suis en train d'étudier la question ! Merci à bientôt J@cD@n