Image from Userform to Sheet

[Jimmypop]

Good day all

I have the code below which works and does pass the Image from Image1 control on my userform AddEmp to a sheet called "Pics" but not to the correct position...

The image is loaded and renamed to Image 1 on userform from Textbox 3 and 5. Now when I click to add to database it needs to do the follwong:

1. Take the image and place it in Cell C1 and then In A1 it needs the text in Textbox3 and in A2 it needs text from Textbox5 (Text boxes located on userform AddEmp).
2. Any subsequent entries need to go to next empty row....
3. Image needs to resize to fit inside the cell it is placed in.

Sub InsertImage(ImageFileName As String, ID As String, Empl As String)
    Dim Image As Object, t As Double, l As Double, w As Double, h As Double, ws As Worksheet, TargetCell As Range
    Set ws = Sheets("Pics")
    If ws Is Nothing Then Exit Sub ' Check if worksheet exists
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' Get last used row in column A
    Set TargetCell = ws.Cells(lastRow + 1, 1) ' Set target cell to the next empty row on Pics sheet
    TargetCell = "'" & ID
    TargetCell.Offset(, 1) = Empl
    ' import picture
    Set Image = ws.Pictures.Insert(ImageFileName)
    ' cell position
    With TargetCell
        t = .Top
        l = .Left
        w = .Width
        h = .Height
    End With
    ' image placement
    With Image
        .Top = t
        .Left = l
        .Width = w
        .Height = h
        .Placement = xlMoveAndSize ' resize image to fit within the target cell
        .Name = ID
    End With
    Set Image = Nothing
End Sub

 

[Jimmypop]

So to explain a bit more...

1. Images are loaded via a button to an Image Control on a Userform...Underneath is original image...(Note this image is rotated here... Cannot upload the unrotated one due to site saying image is too large... Original image is rotated counter clockwise...)



2. This is image after loading to the Userform Image Control...



3. This is how image loads to sheet...



4. I then resize to 200 by 200... It then loads like...



5. And then load the sheet like...



So now my question is... Can I prevent the image from rotating before it goes to Image Control on Userform? How can I make sure that image is not rotating when placed into Image Control...

Below is the code used to load image to Image Control...

Private Function GetImageFile(ByVal Empl As String) As String
    With Application.fileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"
    End With
    pathToFile = Application.GetOpenFilename(Title:="Add Employee Image", FileFilter:=UCase(Empl) & " (*.jpg; *.png; *.gif),*.bas;*.png;*.gif")
    If pathToFile > "" Then GetImageFile = pathToFile
End Function

 

[NdNoviceHlp]

Seems like you can use ShapeRange.IncrementRotation to change the pic's orientation. Maybe add a userform button to rotate the pic before sending it to the sheet. Here's a link. I don't think you need the chart. It seems like after it's loaded in the userform, you should be able to rotate it. HTH. Dave

How do I rotate a saved image with VBA?

I currently have a userform in excel with images displayed on it (saved in a temporary folder "C:\Temp\Photos") What I want to do is have buttons (90, 180, 270) for rotating the images lo...

stackoverflow.com

 

[Jimmypop]

Thanks Dave

Will let you know if working...

 

[Jimmypop]

Not getting it right... not sure how to edit the code given in link to work with image already loaded onto userform...

 

[NdNoviceHlp]

Hi again Jimmypop... I finished my coffee. It turns out that you can't just rotate the image in the userform. You have to place the pic on a sheet, rotate it, make a new file using a chart, delete the sheet pic, reload the sheet pic and then reload the userform image. If you want to trial on a new wb, add a userform (Userform1). Place an image control (Image1), a command button (Command1) and a spin button (Spinbutton1) on the userform. Size your Sheet1 "C" column and rows to your desired pic size. Size the the Userform Image1 to approx. your "C" cell size. Show your userform and click the command button to start. The pic sizes to your destination "C" cell. The pic is converted to a JPG by the chart which can be changed if not suitable by changing the chart export filter. You will need to add a spin button to your current userform and adjust the sheet name, userform name, command button name and route of entry for ID and Emp to suit. It's kind of fun to play with. HTH. Dave
Userform code....

Option Explicit
Dim ImageV As Object, ws As Worksheet, ImageFileName2 As String
Dim ImageCell As Range, TargetCell As Range, Emp As String

Private Sub CommandButton1_Click()
Dim ID As String, PathToFile As Variant
'enter ID ("A" pic Name) and Emp("B" emp name)
ID = Application.InputBox("Enter ID", Title:="Enter ID", Type:=2)
Emp = Application.InputBox("Enter Emp1", Title:="Enter Emp", Type:=2)

'Select image and load to userform1 image1
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"
    End With

PathToFile = Application.GetOpenFilename(Title:="Add Employee Image", _
              FileFilter:=UCase(Emp) & " (*.jpg; *.png; *.gif),*.bas;*.png;*.gif")

'no file selected
If PathToFile <> False Then
ImageFileName2 = PathToFile
Else
MsgBox "No file selected"
Exit Sub
End If

'load userform
With UserForm1.Image1 '********* change userform name and image name to suit
.Picture = LoadPicture(ImageFileName2)
.PictureSizeMode = fmPictureSizeModeClip
End With
'load pic to sheet
Call InsertImage(ImageFileName2, ID, Emp, False)
End Sub

Sub InsertImage(ImageFileName As String, ID As String, Empl As String, Spin As Boolean)
'ImageFileName is file path; ID is pic name; Emp1 is name(?), Spin=true for rotate/False for load pic
'resizes image to cell. Loads pic to cell
'ID in "A"; Emp1 in "B"; pic in "C"
    Dim LastRow As Integer
    'don't do this part more than once ie. only do when loading NOT when rotating
    If Not Spin Then
    Set ws = Sheets("Sheet1") '*********change to suit
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' Get last used row in column A
    Set TargetCell = ws.Cells(LastRow + 1, 1) ' Set target cell to the next empty row on Pics sheet
    TargetCell = "'" & ID
    TargetCell.Offset(, 1) = Empl
    End If
    ' import picture and adjust to cell size
    Set ImageCell = TargetCell.Offset(0, 2).MergeArea
    Set ImageV = ws.Pictures.Insert(ImageFileName)
    With ImageV
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = ImageCell.Left
        .Top = ImageCell.Top
        .Width = ImageCell.Width
        .Height = ImageCell.Height
        .Name = ID
    End With
End Sub

Private Sub SpinButton1_SpinDown()
Dim TStr As String
'if no pic do nothing
If Not ImageV Is Nothing Then
'rotate image on sheet
ImageV.ShapeRange.IncrementRotation -90
'create new pic of rotated image using chart
Call CreateJPG(ImageV.Name, ImageFileName2)
TStr = ImageV.Name
'delete sheet pic
ImageV.Delete
'load pic to sheet
Call InsertImage(ImageFileName2, TStr, Emp, True)
'reload rotated pic to userform
UserForm1.Image1.Picture = LoadPicture(ImageFileName2)
End If
End Sub

Private Sub SpinButton1_SpinUp()
Dim TStr As String
'if no pic do nothing
If Not ImageV Is Nothing Then
'rotate image on sheet
ImageV.ShapeRange.IncrementRotation 90
'create new pic of rotated image using chart
Call CreateJPG(ImageV.Name, ImageFileName2)
TStr = ImageV.Name
'delete sheet pic
ImageV.Delete
'load pic to sheet
Call InsertImage(ImageFileName2, TStr, Emp, True)
'reload rotated pic to userform
UserForm1.Image1.Picture = LoadPicture(ImageFileName2)
End If
End Sub

Sub CreateJPG(PicName As String, FileNm As String)
Dim xRgPic As Shape
'create chart, make image file, delete chart
ws.Activate
Charts.Add.Location Where:=xlLocationAsObject, Name:=ws.Name
With ws.ChartObjects(ws.ChartObjects.Count).Chart
.Parent.Height = ImageCell.Height
.Parent.Width = ImageCell.Width
.Parent.Top = ImageCell.Top
.Parent.Left = ImageCell.Left
End With
Set xRgPic = ws.Shapes(PicName)
xRgPic.CopyPicture
With ws.ChartObjects(ws.ChartObjects.Count)
.Activate
.Chart.Paste
.Chart.Export ImageFileName2, "JPG"
End With
ws.ChartObjects(ws.ChartObjects.Count).Delete
End Sub

 

[NdNoviceHlp]

Whoops! I missed an important caveat... the code replaces your original image file with the JPG created. So it may end up that your original pic has a different size, clarity and/or orientation. Dave

 

[NdNoviceHlp]

I don't like messing with the original file format. So change this part of the code so that the image manipulated is a copy of the image and therefore the original file format is maintained. You may want to delete the copy file when your done with it. Dave

Private Sub CommandButton1_Click()
Dim ID As String, PathToFile As Variant
Dim TempPath As String, Tstr As Variant, Ofsobj As Object

'enter ID ("A" pic Name) and Emp("B" emp name)
ID = Application.InputBox("Enter ID", Title:="Enter ID", Type:=2)
Emp = Application.InputBox("Enter Emp1", Title:="Enter Emp", Type:=2)

'Select image and load to userform1 image1
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"
    End With

PathToFile = Application.GetOpenFilename(Title:="Add Employee Image", _
              FileFilter:=UCase(Emp) & " (*.jpg; *.png; *.gif),*.bas;*.png;*.gif")

'no file selected
If PathToFile <> False Then
TempPath = PathToFile
Else
MsgBox "No file selected"
Exit Sub
End If

'copy pic to use for manipulation. Leave original file format intact
Tstr = Split(TempPath, "\")
ImageFileName2 = Left(TempPath, Len(TempPath) - Len(Tstr(UBound(Tstr))) - 1) & "\Copy" & Tstr(UBound(Tstr))
Set Ofsobj = CreateObject("Scripting.FilesystemObject")
Ofsobj.CopyFile TempPath, ImageFileName2, True
Set Ofsobj = Nothing

'load userform
With UserForm1.Image1 '********* change userform name and image name to suit
.Picture = LoadPicture(ImageFileName2)
.PictureSizeMode = fmPictureSizeModeClip
End With
'load pic to sheet
Call InsertImage(ImageFileName2, ID, Emp, False)
End Sub

 

[Jimmypop]

Hi Dave

Thanks so much for the code.. Hope it did not take to many coffees... I was and still am busy travelling for work so had to put project on ice for awhile... will test when I have a chance

 

[NdNoviceHlp]

Thanks for the update. Enjoy your travels. Dave

 

[Jaafar Tribak]

Dan_W offered you a nice and easy way for rotating images using the WIA library