[PPT-2003] Selectionner et récupérer dans une Imagebox

[Neoxaro]

Bonjour,

Dans une userform, j'ai une imagebox1 (Image, contrôle) et sur celle ci, j'ai une autre imagebox avec comme picture affecté un rectangle (imagebox rectangle plus petite que imagebox1)

Grâce à mousedown, à chaque fois que je clique sur mon imagebox1, mon rectangle ce déplace dessus.

Et je voudrais pouvoir faire un copier de ce que le rectangle encadre et coller celle-ci dans une autre imagebox qui est celle-ci dans une de mes slides.


Pour l'instant mon code :

Code :

1
2
3
4
5
6
7
8
9
10
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
posX = X
posY = Y
 
UserForm5.Image2.Top = posY + 5
UserForm5.Image2.Left = posX + 18
 
ScrollBar1.Value = posY
ScrollBar2.Value = posX
End Sub

Code :

1
2
3
4
Private Sub ScrollBar1_Change()
    UserForm5.Image2.Top = ScrollBar1.Value
 
End Sub

Code :

1
2
3
4
Private Sub ScrollBar2_Change()
    UserForm5.Image2.Left = ScrollBar2.Value
 
End Sub

J'ai cherché, beaucoup ont le même problème en VB6 mais il n'y a aucune information pour récupérer une partie d'une imagebox en VBA

Merci d'avance pour votre aide.

Cordialement

[Philippe JOCHMANS]

Bonjour

Cela aurait été dans une diapositive, je pense à une solution, mais sur un UserForm

Je pense qu'il faudrait que tu ailles voir du coté des tutos de mon ami Arkham : http://arkham46.developpez.com/artic...ice/clgdiplus/

Philippe

[Neoxaro]

Bonjour,

Cela me dérange pas que cela soit dans la slide tant qu'il n'y a pas besoin de lancer le diaporama pour pouvoir le faire.

qu'est ce que ça change si c'est dans une userform ou dans un slide vu que dans les 2 cas c'est une imagebox ?

(j'ai chercher dans les tuto de ton ami mais je n'arrive pas à trouvé le tuto pour faire cela.)
Cordialement

[Philippe JOCHMANS]

Re

Envoyé par Neoxaro

qu'est ce que ça change si c'est dans une userform ou dans un slide vu que dans les 2 cas c'est une imagebox ?

Dans un slide c'est une forme qui contient une image et non un contrôle (bien que l'on puisse le mettre dans un slide.

(j'ai chercher dans les tuto de ton ami mais je n'arrive pas à trouvé le tuto pour faire cela.)

Ce n'est pas écrit tel quel, mais la bibliothèque décrite par Arkham permet de faire pas mal de choses sur les contrôles images.

Philippe

[Neoxaro]

Si cela est plus simple dans une slide, je pense que je vais faire cela dans la slide. Si tu peux m'aider dans ce sens j'accepterais volontiers.

En même temps je vais chercher sur les tutos de ton ami pour ma culture.

Cordialement

[Philippe JOCHMANS]

Bonjour

Voilà à quoi je pense, le code suivant va insérer une image dans une diapositive et un rectangle.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
 
Public objPres As Presentation
Public objSld As Slide
Public objImage As Shape
Public objRec As Shape
 
 
Public Sub Init()
    ' initialisation
    Set objPres = ActivePresentation
    Set objSld = objPres.Slides(1)
 
    ' création de l'image et du rectangle
    Set objImage = objSld.Shapes.AddPicture("C:\Users\Philippe\Pictures\Portrait.jpg", msoTrue, msoTrue, 25, 25)
    Set objRec = objSld.Shapes.AddShape(msoShapeRectangle, 100, 100, 50, 50)
    objRec.Fill.Transparency = 1
 
    Call Rogner
 
End Sub

Ensuite on lance la routine Rogner dont le code suit :

Code :

1
2
3
4
5
6
7
8
9
10
Public Sub Rogner()
    ' rogner l'image par rapport à la position du rectangle crop
    With objImage.PictureFormat
        .CropLeft = objRec.Left - objImage.Left
        .CropTop = objRec.Top - objImage.Top
        .CropRight = (objImage.Left + objImage.Width) - (objRec.Left + objRec.Width)
        .CropBottom = (objImage.Top + objImage.Height) - (objRec.Top + objRec.Height)
    End With
 
End Sub

Le principe est de rogner l'image par rapport au rectangle qui se trouve sur celle-ci, à toi de voir avec des boutons pour déplacer ce rectangle et rogner cette image.

Voilà un début de piste et deux images pour voir le résultat.


Philippe

[Neoxaro]

Bonjour,
Cela marche parfaitement avec une image fixe mais impossible de redimensionner l'image avant de la rogner. Dans le sens ou je voudrais utiliser scaleheight et scalewidth pour changer les dimension vu que mon image de base est très grande. MAis une fois que je fais cela tout le rognage est faux
Le rognage joue sur l'image de base donc si je redimensionne je dois changer apparement le calcul
De plus l'imge n'est plus un carré mais un rectangle mais je pense que cela est "normal" vu que dans la formule, on déduit la largeur et hauteur et vu que je la change ça doit influer mais en quoi je ne sais pas.

Pourtant en changeant la largeur et la hauteur,

voila tous ce que j'ai ajouté.

Code :

1
2
3
4
5
6
7
 ' création de l'image et du rectangle
    Set objImage = objSld.Shapes.AddPicture(Text1, msoTrue, msoTrue, 20, 60)
 
'   objImage.LockAspectRatio = msoTrue
 
    objimage.scaleheight 0.6,msofalse
    objimage.scalewidth 0.6,msofalse

Je pense que dans le calcul quelque chose doit bouger mais je ne sais pas quoi car mon rognage à partir du haut est bon mais pas du coté droit c'est incomprehensible pour moi.
J'ai fait plein de test avec des espions et les variables ne change pas correctement je comprend pas.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public Sub Rogner()
    ' rogner l'image par rapport à la position du rectangle crop
    With objImage.PictureFormat
        .CropLeft = objRec.Left - objImage.Left
        .CropTop = objRec.Top - objImage.Top      
        .CropRight = (objImage.Left + objImage.Width) - (objRec.Left + objRec.Width)
        .CropBottom = (objImage.Top + objImage.Height) - (objRec.Top + objRec.Height)
        objImage.ZOrder msoBringToFront
        objImage.Top = 150
        objImage.Left = 500
        objImage.LockAspectRatio = msoTrue
        objImage.Height = 200
        objRec.Delete
    End With
End Sub

Autre problème maintenant que je n'utilise plus d'ActiveX, impossible d'utiliser de mousedown donc impossible de récuperer la position de la souris et mettre les coordonnées sur le rectangle lorsque je le déssine. L'une des raisons pour laquelle je voulais utiliser des ActiveX.

A part c'est 2 problèmes c'est exactement ce qu'il me faut.

Cordialement

[Philippe JOCHMANS]

Re

Envoyé par Neoxaro

A part c'est 2 problèmes c'est exactement ce qu'il me faut.

J'ai donc bien compris ton problème , par contre je vais prendre compte de tes remarques pour essayer de trouver un truc.

Philippe

[Arkham46]

pas facile ....

j'ai essayé sous ppt 2003, avec une étiquette (trouvée dans la "boite à outils contrôles") pour avoir des événements mousedown et mousemove

il faut un peu bidouiller pour réussir à déplacer correctement cette étiquette à la souris

en pièce-jointe un essais

ça fonctionne à peu près mais si on essaye de déplacer rapidement le rectangle et qu'on le quitte, il faut revenir dessus pour le déplacer à nouveau
il ne faut donc pas être trop rapide

bon courage!

[Neoxaro]

Bonjour,

Merci à toi, c'est exactement ce que je cherche sauf que l'image qui est créée à droite, ne doit pas bouger en même temps que la selection mais doit être fixe et zoomé.

Autre problème, impossible de changer l'image de base. Si je met autre chose que ton image cela plante. Pour cela je pense qu'il faut que j'initialise avec un style comme cela :

Code :

    Set objImageR = objSld.Shapes.AddPicture(CHA, msoTrue, msoTrue, 25, 25)

MAis je ne sais pas où et comment le mettre (sachant que CHA (chemin d'accès) je vais le chercher automatiquement avec une macro donc pas de soucis pour l'avoir)

De plus, il faut obligatoirement lancer le diaporama pour le faire alors qu'il ne faut pas. Alors je pense qu'il faut que j'utilise ce que tu as créé dans une userform car les userform permet d'utiliser la même chose sans lancer le diaporama et ensuite faire un copier/coller de l'image créée dans la slide.


Donc pour cela, le première essai correspondait mieux je pense mais avec les erreurs énoncées

Cordialement