I have a picturebox in a form in excel 2013. I am able to put image there from VBA. Now I want to put that image in a excel cell by clicking a button.
For this I have done the following code:
Sheets("Inventory").Activate
rowno = ActiveSheet.UsedRange.Rows.Count
cellrange = "N" & Trim(Str(rowno))
range(cellrange).Value = Image2.Picture
It gives me no error but displaying some weird numeric values in the cell...
Can anyone please help me with this situation.
i need to go to sleep, but i found this :
SavePicture me.Image2.picture, FileNameString 'saves the picture controlform to disk
and then :
activesheet.pictures.insert (FileNameString) 'gets it back to activecell
or this , works too
activesheet.AddPicture(FileNameString, LinkToFileBoolean, SaveWithDocumentBoolean, LeftDouble, TopDouble, WidthDouble, HeightDouble)
i will try this tomorrow...
EDIT : ok now i got it working, as follows inside the userform page code, and i name a button CommandButton1 :
Private Sub CommandButton1_Click()
Call UserForm_To_Range(Me.Image1, ThisWorkbook.Sheets(1).Cells(1, 1), true, "") 'ImageName , Range_to_paste , Stretch yes/no , path & name of temporary file (i think its a bmp because method 2 not working (?))
'in the previous line, setting the argument true to false will show the image at its original size
End Sub
and inside a standard module (would also work in userform code but like this its all purpose) :
Option Explicit
Sub UserForm_To_Range(ByRef Img As IPictureDisp, Optional ByVal Rg As Range, Optional ByVal Stretch As Boolean = True, Optional ByVal Full_Path_Name As String) ', Optional ByVal Insert_Methode As Long = 1)
'If IsMissing(Rg) Then Set Rg = Selection
'If IsMissing(Full_Path_Name) Then Full_Path_Name = ThisWorkbook.Path
If Rg Is Nothing Then Set Rg = Selection
If Full_Path_Name = "" Then Full_Path_Name = ThisWorkbook.Path
If InStr(1, Full_Path_Name, ".") = 0 Then Full_Path_Name = Full_Path_Name & "\temp.bmp"
SavePicture Img, Full_Path_Name
Dim h$
h = Dir(Full_Path_Name) 'test if exists ; h is the file name without its path
If h <> "" Then
Dim Sh As Worksheet
Dim Pic As Shape
Set Sh = Rg.Parent
With Sh
'Select Case Insert_Methode
' Case 1:
If Stretch Then 'what i call stretch is fit to cell/range
Set Pic = .Shapes.AddPicture(Full_Path_Name, False, True, Rg.Left, Rg.Top, Rg.Width, Rg.Height)
Else
Set Pic = .Shapes.AddPicture(Full_Path_Name, False, True, Rg.Left, Rg.Top, Imag.Width, Imag.Height)
End If
Kill (Full_Path_Name)
'Case 2:
' Set Pic = .Pictures.Insert(Full_Path_Name)
' With Pic
' .Width = Rg.Width '75
' .Height = Rg.Height '100
' .Left = Rg.Left
' .Top = Rg.Top
' End With
'End Select
With Pic
.LockAspectRatio = msoTrue
If Stretch Then
.Placement = xlMoveAndSize
Else
.Placement = xlMove
End If
.LockAspectRatio = msoTrue
'.PrintObject = True
End With
End With
Else
Beep
End If
Set Pic = Nothing
Set Rg = Nothing
Set Sh = Nothing
Set Img = Nothing
End Sub
PS : the parts i removed from the code are not working or make errors.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.