redimenssioner une image

Bonjour,

En supposant que tu veuilles transformer une image("Michd") de
la feuil1 dans le classeur où tu copies la macro en Fichier image (.gif)
pour ensuite l'insérer dans le fichier de ton choix et dans la feuille
de ton choix

'================================ Sub test()

Dim Localisation As String
Dim Sh As Shape, F As Worksheet

'Où sera copié l'image
Localisation = "C:MichD.gif"

Application.ScreenUpdating = False
With ThisWorkbook 'à adapter
With Worksheets("Feuil1") 'à adapter
Set Sh = .Shapes("Michd")
Sh.CopyPicture
End With
Set F = Worksheets.Add
With F
.Paste
With .ChartObjects.Add(0, 0, _
Selection.Width, Selection.Height).Chart
.Paste
.Export Localisation, "GIF"
End With
End With
End With
Application.DisplayAlerts = False
F.Delete
Application.DisplayAlerts = True

With Workbooks("NomDuClasseur.xls") 'à adapter
With Worksheets("Feuil3") 'à adapter
.Shapes.AddPicture Filename:=Localisation, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=.Range("A5").Left, _
Top:=.Range("A5").Top, _
Width:=.Range("A5").Resize(, 5).Width, _
Height:=.Range("A5").Resize(5).Height
End With
End With
Kill Location
End Sub
'================================
MichD
--------------------------------------------
"joseph84" a écrit dans le message de groupe de discussion :
a4c3aa50-12a7-4526-bd4b-fd5af0ce9c2b@1g2000vbu.googlegroups.com...

Bonjour tout le monde,

j'ai besoin d'aide, je voudrais faire un print screen sur un fichier
et le coller sur un autre fichier et le redimenssioner.

est-ce que c est possible?

merci

Merci pour ta réponse,

je voudrais que tu m'explique la ligne suivante:

Set Sh = .Shapes("Michd")

particulierement : .shapes("Michd")

juste pour etre un peux plus precis de ce que je veux faire :

-j'ai deux classeur et je voudrais faire un screenShot sur un des
fichier est venir le coller dans un endroit bien précis sur l'autre
classeur et je besoin aussi de controler les demissions du
screenShot.

merci

| particulierement : .shapes("Michd")

***MichD est simplement le nom de l'image dans la feuille

| Set Sh = .Shapes("Michd")

***Sh est une variable objet qui pointe sur l'objet image("Michd")


Voici un autre exemple si tu veux faire un printscreen de l'écran du fichier
affiché à l'écran et copier l'image dans une feuille d'une autre classeur.

A ) Cette macro suppose que les 2 classeurs sont ouverts
B ) Elle fait une copie de l'écran lorsque la feuil1 est la feuille
active de l'application dans le classeur du classeur où tu
copieras la procédure et copie le "PrintScreen" dans la "Feuil3"
du classeur2.xls
C ) Volontairement, j'ai situé l'image à partir du coin supérieur gauche
de la cellule G5 de la feuil3 où l'image est copiée. Tu choisis
l'emplacement de ton choix et tu lui attribues la largeur et la hauteur
que tu désires.

'---------------------------------------
Sub test()
Application.Wait (Now + (TimeValue("0:00:01")))
Application.ScreenUpdating = False
With ThisWorkbook 'à adapter
With .Worksheets("Feuil1") 'à adapter
.Activate
ActiveWindow.VisibleRange.Select
Call Envoi_Touche_PrintScreen
With Workbooks("Classeur2.xls")
.Activate
With .Worksheets("Feuil3") 'à adapter
.Activate
.Paste
Selection.Left = .Range("G5").Left
Selection.Top = .Range("G5").Top
Selection.Width = 350
Selection.Height = 300
.Range("A1").Activate
End With
End With
.Parent.Activate
.Range("A1").Select
End With
End With
Application.DisplayAlerts = True
End Sub
'---------------------------------------
Sub Envoi_Touche_PrintScreen()
Application.SendKeys "(%{1068})"
End Sub
'---------------------------------------

MichD
--------------------------------------------


"joseph84" a écrit dans le message de groupe de discussion :
65adcffa-3e13-4831-822e-cdfbebf72047@j4g2000prh.googlegroups.com...

Merci pour ta réponse,

je voudrais que tu m'explique la ligne suivante:

Set Sh = .Shapes("Michd")

particulierement : .shapes("Michd")

juste pour etre un peux plus precis de ce que je veux faire :

-j'ai deux classeur et je voudrais faire un screenShot sur un des
fichier est venir le coller dans un endroit bien précis sur l'autre
classeur et je besoin aussi de controler les demissions du
screenShot.

merci

Correctif à apporter :

Pour faire mouche à tout coup, je te suggère d'insérer une temporisation
comme ceci après cette ligne de code : Call Envoi_Touche_PrintScreen

Call Envoi_Touche_PrintScreen
Application.Wait (Now + (TimeValue("0:00:01")))

La procédure devient :
'---------------------------------------
Sub test()
Application.Wait (Now + (TimeValue("0:00:01")))
Application.ScreenUpdating = False
With ThisWorkbook 'à adapter
With .Worksheets("Feuil1") 'à adapter
.Activate
ActiveWindow.VisibleRange.Select
Call Envoi_Touche_PrintScreen
Application.Wait (Now + (TimeValue("0:00:01")))
With Workbooks("Classeur2.xls") ' à adapter
.Activate
With .Worksheets("Feuil3") 'à adapter
.Activate
.Paste
Selection.Left = .Range("G5").Left
Selection.Top = .Range("G5").Top
Selection.Width = 350
Selection.Height = 300
.Range("A1").Activate
End With
End With
.Parent.Activate
.Range("A1").Select
End With
End With
Application.DisplayAlerts = True
End Sub
'---------------------------------------
Sub Envoi_Touche_PrintScreen()
Application.SendKeys "(%{1068})"
End Sub
'---------------------------------------

MichD
--------------------------------------------

Merci beaucoup c'est parfait je voudrais savoir si je peux donner un
nom au print screen parce que j'ai a le supprimer par apres

On pourrait aussi écrire la macro comme ceci :

A ) Lorsque l'on utilise la commande "Sendkeys", il faut lancer
la procédure à partir de l'interface de la feuille de calcul et non
directement à partir de la fenêtre de l'éditeur de code.

B ) Si la touche "NumLock" est désactivée suite à la procédure, tu dois
augmenter la temporisation légèrement après la ligne de code
Call Envoi_Touche_PrintScreen

C ) Cette approche te permet de choisir la cellule dans le coin supérieur
gauche de la feuille...

'---------------------------------------
Sub test()
Application.Wait (Now + (TimeValue("0:00:01")))
Application.ScreenUpdating = False
Application.Goto ThisWorkbook.Worksheets("Feuil1").Range("A1"), True
Call Envoi_Touche_PrintScreen
Application.Wait (Now + (TimeValue("0:00:02")))
Application.Goto Workbooks("Classeur2.xls").Worksheets("Feuil3").Range("G5"), True
With ActiveSheet
.Paste
Selection.Left = .Range("G5").Left
Selection.Top = .Range("G5").Top
Selection.Width = 350
Selection.Height = 300
.Range("A1").Activate
End With
Application.Goto ThisWorkbook.Worksheets("Feuil1").Range("A1"),True
Application.DisplayAlerts = True
End Sub
'---------------------------------------
Sub Envoi_Touche_PrintScreen()
Application.SendKeys "(%{1068})"
End Sub
'---------------------------------------

MichD
--------------------------------------------

| si je peux donner un nom au print screen parce que j'ai a le supprimer par apres

Je ne comprends pas. Qu'est-ce que tu veux supprimer ? La procédure "Envoi_Touche_PrintScreen" ?



MichD
--------------------------------------------
"joseph84" a écrit dans le message de groupe de discussion :
6b8ccc32-655e-42cd-9090-abfe4191abfa@p25g2000pri.googlegroups.com...

Merci beaucoup c'est parfait je voudrais savoir si je peux donner un
nom au print screen parce que j'ai a le supprimer par apres

je voudrais supprimer l'image du print screen

Dans le haut du module, tu déclares une variable
La procédure a été modifiée légèrement. Après que
la procédure a été exécutée au moins une fois, pour
supprimer la dernière image copiée,


Sub Supprimer_Image()
Sh.delete
End Sub

Public Sh As Shape
'-------------------------
Sub test150()
Application.Wait (Now + (TimeValue("0:00:01")))
Application.ScreenUpdating = False
With ThisWorkbook 'à adapter
With .Worksheets("Feuil1") 'à adapter
.Activate
ActiveWindow.VisibleRange.Select
Call Envoi_Touche_PrintScreen
Application.Wait (Now + (TimeValue("0:00:01")))
With Workbooks("Classeur2.xls") ' à adapter
.Activate
With .Worksheets("Feuil3") 'à adapter
.Activate
.Paste
Set Sh = Selection
Sh.Left = .Range("G5").Left
Sh.Top = .Range("G5").Top
Sh.Width = 350
Sh.Height = 300
.Range("A1").Activate
End With
End With
.Parent.Activate
.Range("A1").Select
End With
End With
Application.DisplayAlerts = True
End Sub



MichD
--------------------------------------------
"joseph84" a écrit dans le message de groupe de discussion :
b3a95be9-2d9e-46d4-86fe-3d2052b4926f@g19g2000prf.googlegroups.com...

je voudrais supprimer l'image du print screen

merci beaucoup pour ton aide rien sa fonctionne apres que j'ai change"
Application.ScreenUpdating = False " à true parce que le print screen
va se faire sur le classeur ou je veux coller mon print screen.

encore merci :)