Bonjour j'ai inséré des images dans un fichier excel ,est ce qui y a une façon
pour reprendre des photos et les placé dans ex: mes image ? j'ai essayer de
couper/coller , glisser et rien ne fonctionne Merci
Avec Copier/Coller Il faut utiliser un logiciel d'image (Paint, Paint Shop Pro, Photo Shop .....etc)
Et enregistrer au format souhaité
Celà devrait convenir
Dis moi !!!!!!
michdenis
Bonjour J-Marc,
Une façon de faire qui a été publié ici par Michel Perron :
Après avoir copier tout ce qui suit dans un module standard, tu sélectionnes l'image dans ta feuille de calcul et tu appelless la procédure suivante : Sub SaveSelectionAsBmp() Dans cette même procédure, prend le temps de définir où tu veux enregistrer le fichier créé.
Attention s'il y a des lignes de code coupées par le service de messagerie.
'-------------------------------------------- 'Dans le haut d'un module standard, déclaration des Api Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&) Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%) Private Declare Function CloseClipboard& Lib "user32" () Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" _ (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, iPic As IPicture) Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1& _ , ByVal n1&, ByVal n2&, ByVal un2&) Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type '-------------------------------------------- Private Function PasteBmp() As IPicture Dim hCopy As Long OpenClipboard (0&) hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4) CloseClipboard If hCopy Then Set PasteBmp = CreateBmp(hCopy) End Function '-------------------------------------------- Private Function CreateBmp(ByVal hPic As Long) As IPicture Dim i As Long, uPic As uPicDesc, PicStore As GUID, iPic As IPicture ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB} With PicStore .Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A .Data4(0) = &H8B For i = 1 To 7 .Data4(i) = Choose(i, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB) Next i End With With uPic .Size = Len(uPic): .Type = 1: .hPic = hPic: .hPal = 0 End With OleCreatePictureIndirect uPic, PicStore, 1, iPic Set CreateBmp = iPic End Function '-------------------------------------------- Sub SaveSelectionAsBmp() On Error GoTo Bug Dim oPic As IPictureDisp, BmpFile As String Selection.CopyPicture xlScreen, xlBitmap
'Tu indiques où tu veux enregistrer le fichier et son nom. BmpFile = "C:" & "Temp.bmp" Set oPic = PasteBmp: SavePicture oPic, BmpFile Exit Sub Bug: MsgBox "Error " & Err.Number & vbLf & Err.Description & " !", 48 End Sub '--------------------------------------------
"j-marc" a écrit dans le message de groupe de discussion : Bonjour j'ai inséré des images dans un fichier excel ,est ce qui y a une façon pour reprendre des photos et les placé dans ex: mes image ? j'ai essayer de couper/coller , glisser et rien ne fonctionne Merci
Bonjour J-Marc,
Une façon de faire qui a été publié ici par Michel Perron :
Après avoir copier tout ce qui suit dans un module standard,
tu sélectionnes l'image dans ta feuille de calcul et tu appelless
la procédure suivante : Sub SaveSelectionAsBmp()
Dans cette même procédure, prend le temps de définir où
tu veux enregistrer le fichier créé.
Attention s'il y a des lignes de code coupées par le service
de messagerie.
'--------------------------------------------
'Dans le haut d'un module standard, déclaration des Api
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, iPic As IPicture)
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1& _
, ByVal n1&, ByVal n2&, ByVal un2&)
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
'--------------------------------------------
Private Function PasteBmp() As IPicture
Dim hCopy As Long
OpenClipboard (0&)
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy)
End Function
'--------------------------------------------
Private Function CreateBmp(ByVal hPic As Long) As IPicture
Dim i As Long, uPic As uPicDesc, PicStore As GUID, iPic As IPicture
' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
With PicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
.Data4(0) = &H8B
For i = 1 To 7
.Data4(i) = Choose(i, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
Next i
End With
With uPic
.Size = Len(uPic): .Type = 1: .hPic = hPic: .hPal = 0
End With
OleCreatePictureIndirect uPic, PicStore, 1, iPic
Set CreateBmp = iPic
End Function
'--------------------------------------------
Sub SaveSelectionAsBmp()
On Error GoTo Bug
Dim oPic As IPictureDisp, BmpFile As String
Selection.CopyPicture xlScreen, xlBitmap
'Tu indiques où tu veux enregistrer le fichier et son nom.
BmpFile = "C:" & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
Exit Sub
Bug: MsgBox "Error " & Err.Number & vbLf & Err.Description & " !", 48
End Sub
'--------------------------------------------
"j-marc" <jmarc@discussions.microsoft.com> a écrit dans le message de groupe de discussion
: C10C5C10-05C5-4EED-8E23-29A19705C7A2@microsoft.com...
Bonjour j'ai inséré des images dans un fichier excel ,est ce qui y a une façon
pour reprendre des photos et les placé dans ex: mes image ? j'ai essayer de
couper/coller , glisser et rien ne fonctionne Merci
Une façon de faire qui a été publié ici par Michel Perron :
Après avoir copier tout ce qui suit dans un module standard, tu sélectionnes l'image dans ta feuille de calcul et tu appelless la procédure suivante : Sub SaveSelectionAsBmp() Dans cette même procédure, prend le temps de définir où tu veux enregistrer le fichier créé.
Attention s'il y a des lignes de code coupées par le service de messagerie.
'-------------------------------------------- 'Dans le haut d'un module standard, déclaration des Api Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&) Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%) Private Declare Function CloseClipboard& Lib "user32" () Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" _ (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, iPic As IPicture) Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1& _ , ByVal n1&, ByVal n2&, ByVal un2&) Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type '-------------------------------------------- Private Function PasteBmp() As IPicture Dim hCopy As Long OpenClipboard (0&) hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4) CloseClipboard If hCopy Then Set PasteBmp = CreateBmp(hCopy) End Function '-------------------------------------------- Private Function CreateBmp(ByVal hPic As Long) As IPicture Dim i As Long, uPic As uPicDesc, PicStore As GUID, iPic As IPicture ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB} With PicStore .Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A .Data4(0) = &H8B For i = 1 To 7 .Data4(i) = Choose(i, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB) Next i End With With uPic .Size = Len(uPic): .Type = 1: .hPic = hPic: .hPal = 0 End With OleCreatePictureIndirect uPic, PicStore, 1, iPic Set CreateBmp = iPic End Function '-------------------------------------------- Sub SaveSelectionAsBmp() On Error GoTo Bug Dim oPic As IPictureDisp, BmpFile As String Selection.CopyPicture xlScreen, xlBitmap
'Tu indiques où tu veux enregistrer le fichier et son nom. BmpFile = "C:" & "Temp.bmp" Set oPic = PasteBmp: SavePicture oPic, BmpFile Exit Sub Bug: MsgBox "Error " & Err.Number & vbLf & Err.Description & " !", 48 End Sub '--------------------------------------------
"j-marc" a écrit dans le message de groupe de discussion : Bonjour j'ai inséré des images dans un fichier excel ,est ce qui y a une façon pour reprendre des photos et les placé dans ex: mes image ? j'ai essayer de couper/coller , glisser et rien ne fonctionne Merci
j-marc
Merci ca fonctionne tres bien
"michdenis" wrote:
Bonjour J-Marc,
Une façon de faire qui a été publié ici par Michel Perron :
Après avoir copier tout ce qui suit dans un module standard, tu sélectionnes l'image dans ta feuille de calcul et tu appelless la procédure suivante : Sub SaveSelectionAsBmp() Dans cette même procédure, prend le temps de définir où tu veux enregistrer le fichier créé.
Attention s'il y a des lignes de code coupées par le service de messagerie.
'-------------------------------------------- 'Dans le haut d'un module standard, déclaration des Api Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&) Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%) Private Declare Function CloseClipboard& Lib "user32" () Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" _ (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, iPic As IPicture) Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1& _ , ByVal n1&, ByVal n2&, ByVal un2&) Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type '-------------------------------------------- Private Function PasteBmp() As IPicture Dim hCopy As Long OpenClipboard (0&) hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4) CloseClipboard If hCopy Then Set PasteBmp = CreateBmp(hCopy) End Function '-------------------------------------------- Private Function CreateBmp(ByVal hPic As Long) As IPicture Dim i As Long, uPic As uPicDesc, PicStore As GUID, iPic As IPicture ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB} With PicStore .Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A .Data4(0) = &H8B For i = 1 To 7 .Data4(i) = Choose(i, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB) Next i End With With uPic .Size = Len(uPic): .Type = 1: .hPic = hPic: .hPal = 0 End With OleCreatePictureIndirect uPic, PicStore, 1, iPic Set CreateBmp = iPic End Function '-------------------------------------------- Sub SaveSelectionAsBmp() On Error GoTo Bug Dim oPic As IPictureDisp, BmpFile As String Selection.CopyPicture xlScreen, xlBitmap
'Tu indiques où tu veux enregistrer le fichier et son nom. BmpFile = "C:" & "Temp.bmp" Set oPic = PasteBmp: SavePicture oPic, BmpFile Exit Sub Bug: MsgBox "Error " & Err.Number & vbLf & Err.Description & " !", 48 End Sub '--------------------------------------------
"j-marc" a écrit dans le message de groupe de discussion : Bonjour j'ai inséré des images dans un fichier excel ,est ce qui y a une façon pour reprendre des photos et les placé dans ex: mes image ? j'ai essayer de couper/coller , glisser et rien ne fonctionne Merci
Merci ca fonctionne tres bien
"michdenis" wrote:
Bonjour J-Marc,
Une façon de faire qui a été publié ici par Michel Perron :
Après avoir copier tout ce qui suit dans un module standard,
tu sélectionnes l'image dans ta feuille de calcul et tu appelless
la procédure suivante : Sub SaveSelectionAsBmp()
Dans cette même procédure, prend le temps de définir où
tu veux enregistrer le fichier créé.
Attention s'il y a des lignes de code coupées par le service
de messagerie.
'--------------------------------------------
'Dans le haut d'un module standard, déclaration des Api
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, iPic As IPicture)
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1& _
, ByVal n1&, ByVal n2&, ByVal un2&)
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
'--------------------------------------------
Private Function PasteBmp() As IPicture
Dim hCopy As Long
OpenClipboard (0&)
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy)
End Function
'--------------------------------------------
Private Function CreateBmp(ByVal hPic As Long) As IPicture
Dim i As Long, uPic As uPicDesc, PicStore As GUID, iPic As IPicture
' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
With PicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
.Data4(0) = &H8B
For i = 1 To 7
.Data4(i) = Choose(i, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
Next i
End With
With uPic
.Size = Len(uPic): .Type = 1: .hPic = hPic: .hPal = 0
End With
OleCreatePictureIndirect uPic, PicStore, 1, iPic
Set CreateBmp = iPic
End Function
'--------------------------------------------
Sub SaveSelectionAsBmp()
On Error GoTo Bug
Dim oPic As IPictureDisp, BmpFile As String
Selection.CopyPicture xlScreen, xlBitmap
'Tu indiques où tu veux enregistrer le fichier et son nom.
BmpFile = "C:" & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
Exit Sub
Bug: MsgBox "Error " & Err.Number & vbLf & Err.Description & " !", 48
End Sub
'--------------------------------------------
"j-marc" <jmarc@discussions.microsoft.com> a écrit dans le message de groupe de discussion
: C10C5C10-05C5-4EED-8E23-29A19705C7A2@microsoft.com...
Bonjour j'ai inséré des images dans un fichier excel ,est ce qui y a une façon
pour reprendre des photos et les placé dans ex: mes image ? j'ai essayer de
couper/coller , glisser et rien ne fonctionne Merci
Une façon de faire qui a été publié ici par Michel Perron :
Après avoir copier tout ce qui suit dans un module standard, tu sélectionnes l'image dans ta feuille de calcul et tu appelless la procédure suivante : Sub SaveSelectionAsBmp() Dans cette même procédure, prend le temps de définir où tu veux enregistrer le fichier créé.
Attention s'il y a des lignes de code coupées par le service de messagerie.
'-------------------------------------------- 'Dans le haut d'un module standard, déclaration des Api Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&) Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%) Private Declare Function CloseClipboard& Lib "user32" () Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" _ (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, iPic As IPicture) Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1& _ , ByVal n1&, ByVal n2&, ByVal un2&) Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type '-------------------------------------------- Private Function PasteBmp() As IPicture Dim hCopy As Long OpenClipboard (0&) hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4) CloseClipboard If hCopy Then Set PasteBmp = CreateBmp(hCopy) End Function '-------------------------------------------- Private Function CreateBmp(ByVal hPic As Long) As IPicture Dim i As Long, uPic As uPicDesc, PicStore As GUID, iPic As IPicture ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB} With PicStore .Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A .Data4(0) = &H8B For i = 1 To 7 .Data4(i) = Choose(i, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB) Next i End With With uPic .Size = Len(uPic): .Type = 1: .hPic = hPic: .hPal = 0 End With OleCreatePictureIndirect uPic, PicStore, 1, iPic Set CreateBmp = iPic End Function '-------------------------------------------- Sub SaveSelectionAsBmp() On Error GoTo Bug Dim oPic As IPictureDisp, BmpFile As String Selection.CopyPicture xlScreen, xlBitmap
'Tu indiques où tu veux enregistrer le fichier et son nom. BmpFile = "C:" & "Temp.bmp" Set oPic = PasteBmp: SavePicture oPic, BmpFile Exit Sub Bug: MsgBox "Error " & Err.Number & vbLf & Err.Description & " !", 48 End Sub '--------------------------------------------
"j-marc" a écrit dans le message de groupe de discussion : Bonjour j'ai inséré des images dans un fichier excel ,est ce qui y a une façon pour reprendre des photos et les placé dans ex: mes image ? j'ai essayer de couper/coller , glisser et rien ne fonctionne Merci