need a little help with LoadPicture

[tango71]

ok, so here goes. what im trying to achieve is to be able to grab the exact replica or photo of everything included in " Front of check" worksheet and view it on a separate form in vba after clicking a button. sort of like a photo preview. however, when i debug it it crashes at

Set Picture = LoadPicture("C:\CheckMaster\temp\MyPic.jpg")

what the heck am i missing? Ive been at this for about 3 hours and have tried other things too.

here is what i have so far...

Private Sub CommandButton1_Click()Sheets(" Front of check").Activate
'Prepare to copy
Range("A1:L20").Copy
Sheets("sheet3").Activate
Range("A1").Select
ActiveSheet.Pictures.Paste Link:=True
ActiveSheet.Pictures.Select
Application.CutCopyMode = False
Dim myChart As String, myPicture As String
Dim picWidth As Long, picHeight As Long


Application.ScreenUpdating = False


myPicture = Selection.Name
With Selection
picHeight = .ShapeRange.Height
picWidth = .ShapeRange.Width
End With


Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet3"
Selection.Border.LineStyle = 0
myChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)




 
With ActiveSheet
With .Shapes(myChart)
.Width = picWidth
.Height = picHeight
End With


.Shapes(myPicture).Copy


With ActiveChart
.ChartArea.Select
.Paste
End With


.ChartObjects(1).Chart.Export Filename:="C:\CheckMaster\temp\MyPic.jpg", FilterName:="jpg"
.Shapes(myChart).Cut
End With

Application.ScreenUpdating = True

Set Picture = LoadPicture("C:\CheckMaster\temp\MyPic.jpg")
ActiveSheet.Pictures.Delete


End Sub

 

[DanteAmor]

The LoadPicture method loads a image into an ActiveX control.

So, to use LoadPicture, you must create a Image Control Activex .
So, it would be like this:

Set [COLOR=#0000ff]ActiveSheet.Image1.[/COLOR]Picture = LoadPicture("C:\CheckMaster\temp\MyPic.jpg")

--------------
Or this other way:

Set wPicture = ActiveSheet.Pictures.Insert("C:\CheckMaster\temp\MyPic.jpg")

 

[tango71]

Dante, I think I tried that earlier. And just tried again and still crashing on that line. says "Sub or function not defined" Im drawing a blank....

 

[DanteAmor]

Which of the 2 ways did you try?
Did you try again with what I put?

Just try this:

Sub im3()
    Ruta = "[COLOR=#ff0000]c:\trabajo\books\[/COLOR]"
    arch = "[COLOR=#ff0000]zone.jpg[/COLOR]"
    ActiveSheet.Pictures.Insert (Ruta & arch)
End Sub

change "c:\trabajo\books\" and "zone.jpg"

 

[tango71]

i tried method 1- same error
method 2 appeared to want to work. however, it hit a runtime error -2147221040(800401d0) method 'copy' of object 'shape' failed...ideas?

 

[DanteAmor]

Try the code in post #5 change the folder and the name of the file for an existing file. Just to see if it works in your excel version.

 

[tango71]

i just tried that way on a blank workbook and it loaded fine, I will try this way to get it to load. and will post results.

 

[DanteAmor]

Ok, let me know if you have any questions.

 

[tango71]

Ok, so i was messing with this code most of the day yesterday trying different things. However, I get one thing to work and something else bugs out. my latest is

"myPicture = Selection.name"

line is crashing. runtime error 438 "object doesnt support this property or method" the rest of the code is as follows

Private Sub CommandButton1_Click() 
Sheets(" Front of check").Activate
'Prepare to copy
Range("A1:L20").Copy
Sheets("sheet3").Activate
Range("A1").Select
ActiveSheet.Pictures.Paste Link:=True
ActiveSheet.Pictures.Select
Application.CutCopyMode = False
Dim myChart As String, myPicture As String
Dim picWidth As Long, picHeight As Long




Application.ScreenUpdating = False




myPicture = Selection.Name
With Selection
picHeight = .ShapeRange.Height
picWidth = .ShapeRange.Width
End With




Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet3"
Selection.Border.LineStyle = 0
myChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)








 
With ActiveSheet
With .Shapes(myChart)
.Width = picWidth
.Height = picHeight
End With




.Shapes(myPicture).Copy




With ActiveChart
.ChartArea.Select
.Paste
End With




.ChartObjects(1).Chart.Export Filename:="C:\CheckMaster\temp\MyPic.jpg", FilterName:="jpg"
.Shapes(myChart).Cut
End With


Application.ScreenUpdating = True


 Set Img = UserForm3.Controls.Add("Forms.Image.1")
    
    With Img
        'Load Picture to Image Control
        Dire = "C:\CheckMaster\Temp"
        Pict = "MyPic.jpg"
        ActiveSheet.Pictures.Insert (Dire & Pict)
        
        'Align the Picture Size
        .PictureSizeMode = fmPictureSizeModeStretch
        
        'Image Position
        .Left = 50
        .Top = 10
    End With
ActiveSheet.Pictures.Delete




End Sub

Im kind of running out of luck on this. Im very limited as to my knowledge in VBA scripting. I recently read a post which described using libs but it was for 32bit and im using 64bit. couldnt get it to work after updating the 32bit references. Im using Office 365 if that matters. dont think it does though.

 

[DanteAmor]

In which line do you have the problem?


Try this

Private Sub UserForm_Activate()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim h1 As Worksheet, h2 As Worksheet, anc, alt, archivo As String, rango As String
    Set h1 = Sheets("Sheet1")
    Set h2 = Sheets.Add
    archivo = ThisWorkbook.Path & "\" & "temp.jpeg"
    '
    rango = "A1:F18"                'range to show
    '
    anc = h1.Range(rango).Width
    alt = h1.Range(rango).Height
    '
    h1.Range(rango).CopyPicture
    h2.Shapes.AddChart
    With h2.ChartObjects(1)
        .Width = anc + 2
        .Height = alt + 2
        .Chart.Paste
        .Chart.Export archivo
        .Delete
    End With
    h2.Delete
    '
    Image1.Picture = LoadPicture(archivo)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = True
End Sub

My file test:
https://www.dropbox.com/s/74iwgzixtnkxad3/cell to userform.xlsm?dl=0