Chart picture vs camera tool - Which to use?

M

Mr_Ragweed2

Board Regular
Joined
Nov 11, 2022
Messages
145
Office Version
  1. 365
Platform
  1. Windows
Hello all! I have been reading posts here and online and i'm not sure which path to try. I have a Userform with many buttons that lead to various "Orderforms" - 1 per vendor. What my macro does is capture the info from each vendor onto 1 "Summary" Sheet and 1 "customer info" sheet. (I guess i could technically combine the data into 1 sheet behind the scenes.) What i would like to do is put the data from both of those sheets back onto the userform when the user is finished, and then make the userform printable. I have set aside space on the form to house this. Which is better/easier (I redefine novice every time i use VBA), chart picture or camera tool? Will i be able to "choose" where i place it on the userform?
I will happily share some code and/or screenshots of the Userform - just didn't want to waste anyone's time if this is not even possible.
Even if there is no help here, but you're aware of something you've seen - all help is greatly appreciated.

Total width of data is 12 columns and total number of rows (including headers and blank rows) is dynamic from 8 to 21. So not a large table/chart/picture.
I'm on Windows 10, Office 365
Thank you very much!
 
Sort by date Sort by votes
Code: 
Public Sub CreateJpg(SheetName As String, xRgAddrss As Range)
Call CreateJpg("Sheet1", Sheets("Sheet1").Range("A1:H8"))
The code that I posted requires 2 parameters be inputted: the sheet name and the range. So for you it would be...
Code: 
Call CreateJpg("Combined data", Sheets("Combined data").Range("A" & firstrow & ":L" & lastrow))
Where you would set the firstrow and lastrow of the range before calling the sub. HTH. Dave
 
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
I'm getting there. Sorry for my ignorance on some of this. I have attached all of the code that it is attached to the button (it's short). This bit that you just created is at the end. It has to execute last.
I am getting a "type mismatch error on my firstrow (and i assume on my lastrow) line.


VBA Code: 
Private Sub CommandButton7Finish_Click()

Application.ScreenUpdating = False

Sheets("Customer info").Select
     
Dim FinalRow As Long

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To 2
        If Cells.Range("B1").Value <> "" = True Then
            Sheets("Customer info").Range("A12:G16").Copy
            
    Sheets("Combined data").Select
    Range("C1").PasteSpecial Paste:=xlPasteValues
        
        End If

'Cuts out blank columns
    Sheets("Order Summary").Select
    Range("D:D,F:F,H:H,J:J,L:L,R:R,S:S").Select
    Selection.Delete Shift:=xlToLeft

        If Cells.Range("B2").Value <> "" = True Then
            ActiveSheet.Range("B1:M" & FinalRow).Select
            Selection.Copy
    Sheets("Combined data").Select
    Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Columns("C:L").EntireColumn.AutoFit
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlCenter
        
    End With
    Range("A6:L6").Select
    Selection.Font.Bold = True
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
    
    Range("C1,C3,C5,F3,H1,H3,H5").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    Range("I1").Select
    Selection.NumberFormat = "m/d/yyyy"
        End If
    Next i

  'Re-inserts columns on Order Summary sheet after EVERYTHING ELSE is DONE
  Sheets("Order Summary").Select
  Columns("D:D").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("F:F").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("H:H").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("J:J").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("L:L").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("R:S").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  
Worksheets("Combined data").Activate

Dim firstrow As Long
Dim lastrow As Long

 firstrow = Worksheets("Combined data").Range("A1:L1")
 lastrow = Worksheets("Combined data").Cells(Rows.Count, 1).EndxlUp.Row


Call CreateJpg("Combined data", Sheets("Combined data").Range("A" & firstrow & ":L" & lastrow))
Dim xRgAddress As Range
Dim xRgPic As Range
Worksheets("Combined data").Activate
Set xRgPic = xRgAddress
xRgPic.CopyPicture   'Error here: "Object variable or With block variable not set"

With ThisWorkbook.Worksheets("Combined data").ChartObjects.Add(UserForm1_MasterSeedOrderForm.Image3.Left, _
            UserForm1_MasterSeedOrderForm.Image3.Top, UserForm1_MasterSeedOrderForm.Image3.Width, UserForm1.Image3.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "" & "TempChart.jpeg", "JPG"
End With
Worksheets("Combined data").ChartObjects(Worksheets("Combined data").ChartObjects.Count).Delete
UserForm1_MasterSeedOrderForm.Image3.Picture = LoadPicture(Environ$("temp") & "" & "TempChart.jpg")
Kill Environ$("temp") & "" & "TempChart.jpg"



End Sub
 
Upvote 0
i'm sorry. it is giving me an 'invalid procedure or call argument' error on that line when i run it from the button.
 
Upvote 0
i'm really messing this up and confusing the heck out of myself. This is to reset the stage:
The above code is what i currently have attached to the button.

Module 5 is just your bit of code. Attached below:
VBA Code: 
Public Sub CreateJpg(SheetName As String, xRgAddress As Range)

Dim firstrow As Long
Dim lastrow As Long

Set firstrow = Worksheets("Combined data").Range("A1:L1")
Set lastrow = Worksheets("Combined data").Range(Rows.Count, 1).EndxlUp.Row


Call CreateJpg("Combined data", Sheets("Combined data").Range("A" & firstrow & ":L" & lastrow))
Dim xRgAddress As Range
Dim xRgPic As Range
Worksheets("Combined data").Activate
Set xRgPic = xRgAddress
xRgPic.CopyPicture

With ThisWorkbook.Worksheets("Combined data").ChartObjects.Add(UserForm1_MasterSeedOrderForm.Image3.Left, _
            UserForm1_MasterSeedOrderForm.Image3.Top, UserForm1_MasterSeedOrderForm.Image3.Width, UserForm1.Image3.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "" & "TempChart.jpeg", "JPG"
End With
Worksheets("Combined data").ChartObjects(Worksheets("Combined data").ChartObjects.Count).Delete
UserForm1_MasterSeedOrderForm.Image3.Picture = LoadPicture(Environ$("temp") & "" & "TempChart.jpg")
Kill Environ$("temp") & "" & "TempChart.jpg"

End Sub


I'm having trouble with this line:
VBA Code: 
Public Sub CreateJpg("Combined data", Sheets("Combined data").Range("A" & firstrow & ":L" & lastrow))
I get an "Expected: identifier" highlighting the words combined data

If i try to type the line as below, it wont let me :highlights As and says "expected list separator"
VBA Code: 
Call CreateJpg(SheetName As String, xRgAddrss As Range)

i don't know what to type where at this point. i've never "called' anything before as part of my code.
 
Upvote 0
It'S not...
Code: 
Public Sub CreateJpg("Combined data", Sheets("Combined data").Range("A" & firstrow & ":L" & lastrow))
Paste the code I posted AS IS to a module. Get rid of all that other code after the following line in your command code and use this line to call the sub..
Code: 
Call CreateJpg("Combined data", Sheets("Combined data").Range("A" & firstrow & ":L" & lastrow))
Dave
 
Upvote 0
Ok. I did everything you just said, but i had to change the image name to "image3" because that the name in the properties window since i have two other images. Your suggestion made more sense to me this time.
I'm getting an "object required" error here: (yellow arrow points to the second line).
In the properties of my userform. i see it's called "Userform1_MasterSeedOrderForm". I tried changing all of the "userform1" to that and got the same error.
VBA Code: 
With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(UserForm1.Image3.Left, _
                UserForm1.Image3.Top, UserForm1.Image3.Width, UserForm1.Image3.Height)
I really apologize for my shortcomings here.
 
Upvote 0
Update. So i forgot to rename one of the Userform1 to Userform1_MasterSeedOrder. Once i did that i stopped getting the error. I see on the userform when its running that the image changes from light grey to a dark grey, but that's it. No errors but no chart image.
 
Upvote 0
Did you also change this line of code...
Code: 
Userform1_MasterSeedOrder.Image3.Picture = LoadPicture(Environ$("temp") & "" & "TempChart.jpg")
I tested the code before I posted and it worked well. It should work for you. Dave
 
Upvote 0
i did. here it is :
VBA Code: 
Public Sub CreateJpg(SheetName As String, xRgAddrss As Range)
'Userform code ****adjust Userform1 & Image1 to suit
'creates temp JPG file of range (xRgAddrss) by creating temp chart
'uses current wb sheet (sheetname) to locate temp chart
'To operate:  Call CreateJpg("Sheet1", Sheets("Sheet1").Range("A1:H8"))
'adjust sheet name and range to suit
Dim xRgPic As Range
Worksheets("Combined data").Activate
Set xRgPic = xRgAddrss
xRgPic.CopyPicture
With ThisWorkbook.Worksheets("Combined data").ChartObjects.Add(UserForm1_MasterSeedOrderForm.Image3.Left, _
                UserForm1_MasterSeedOrderForm.Image3.Top, UserForm1_MasterSeedOrderForm.Image3.Width, UserForm1_MasterSeedOrderForm.Image3.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "" & "TempChart.jpg", "JPG"
End With
Worksheets("Combined data").ChartObjects(Worksheets("Combined data").ChartObjects.Count).Delete
UserForm1_MasterSeedOrderForm.Image3.Picture = LoadPicture(Environ$("temp") & "" & "TempChart.jpg")
Kill Environ$("temp") & "" & "TempChart.jpg"
End Sub
Just curious - Why can't i step through this like i can other code? It just give me the windows error tones like the form is open.
Also it is not visible like my other subs when i click the macros button.

Here is a shot of the data in case there are blank cells causing a problem:
1669037112333.png


Here is the bit of code where it is called from the button. Your code is the last line:
VBA Code: 
Private Sub CommandButton7Finish_Click()

Application.ScreenUpdating = False

Sheets("Customer info").Select
     
Dim FinalRow As Long

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To 2
        If Cells.Range("B1").Value <> "" = True Then
            Sheets("Customer info").Range("A12:G16").Copy
            
    Sheets("Combined data").Select
    Range("C1").PasteSpecial Paste:=xlPasteValues
        
        End If

'Cuts out blank columns
    Sheets("Order Summary").Select
    Range("D:D,F:F,H:H,J:J,L:L,R:R,S:S").Select
    Selection.Delete Shift:=xlToLeft

        If Cells.Range("B2").Value <> "" = True Then
            ActiveSheet.Range("B1:M" & FinalRow).Select
            Selection.Copy
    Sheets("Combined data").Select
    Range("A6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Columns("C:L").EntireColumn.AutoFit
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlCenter
        
    End With
    Range("A6:L6").Select
    Selection.Font.Bold = True
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
    
    Range("C1,C3,C5,F3,H1,H3,H5").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    Range("I1").Select
    Selection.NumberFormat = "m/d/yyyy"
        End If
    Next i

  'Re-inserts columns on Order Summary sheet after EVERYTHING ELSE is DONE
  Sheets("Order Summary").Select
  Columns("D:D").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("F:F").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("H:H").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("J:J").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("L:L").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("R:S").Select
  Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
  
'Worksheets("Combined data").Activate

Call CreateJpg("Combined data", Sheets("Combined data").Range("A" & firstrow & ":L" & lastrow))

End Sub
 
Upvote 0
Trial changing this line to..
Code: 
With Sheets(SheetName).ChartObjects.Add(xRgAddrss.Left, xRgAddrss.Top, xRgAddrss.Width, xRgAddrss.Height)
That will make the picture the size of your range. The previous code made the picture the size of your image control. I suspect that your image control size is much smaller than your range size. They need to be close to a match. Not sure why you can't step through the code. The sub is not listed in your macros because of the parameters. Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
Automating "Place in Cell" for Pictures Inserted in Excel Using VBA or Other Tools
Replies
1
Views
154
jolivanes
jolivanes
MrIfOnly
  • Question Question
shapes.onaction in add-in using reference path to macro (Excel VBA)
Replies
8
Views
153
jkpieterse
jkpieterse
B
  • Question Question
VBA to edit/update cells within a large table from a common "Dashboard"
Replies
1
Views
503
brianv
B
N
  • Question Question
2-step Dynamic Ranges and Charts
Replies
0
Views
1K
Nick Loughton
N
S
  • Question Question
Organization Chart Formula
Replies
3
Views
706
ShogunStealth
S

Forum statistics

Threads
1,224,820
Messages
6,181,159
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top