Need to shell out, open ".jpg" and print to fit page width

[sspatriots]

I realize this is only a start, but I need to be able to shell out and open a file with the name "Test.jpg" and print it out while ensuring that it will print on the width of a single sheet of paper in portrait orientation. I see a lot of code with send keys, but none of that worked for me when I tried it and figured there must be something much simpler to do here. Any help would be much appreciated. Thanks, SS

Private Sub cmdPrintJobStatus_Click()

VBA.Shell "EXPLORER.EXE \\SomeFolder\PROJECTS\Test.jpg", vbNormalFocus

End Sub

 

[jolivanes]

Can you bring it into an excel sheet and print it?

 

[sspatriots]

I've tried that, but nothing would work so that I could print it in portrait mode and fit the width of the page.

 

[jolivanes]

It should be no problem setting the width/height of an inserted picture or shape.
I'll get something in a while when I have a few moments.

 

[jolivanes]

Sub Is_This_A_Start()
With Range("A1")
    ActiveSheet.Shapes.AddPicture("C:\Folder Name Here\Picture Name Including Extension Here", False, True, 0, 0, Columns(10).Left, Rows("46").Top).Name = "Picture 1"
    .Resize(46, 9).PrintOut
End With
End Sub

From VB Help
Shapes.AddPicture Method
Creates a picture from an existing file. Returns a Shape object that represents the new picture.
Syntax
expression.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

 

[jolivanes]

Another possibility that's easy to change. It maintains the ratio height/width of the original size.
Change references as and where required.

Sub Another_Way()
Dim sShape As Picture
Set sShape = ActiveSheet.Pictures.Insert("C:\Folder Name Here\Picture Name Including Extension Here")
    With sShape
        .ShapeRange.LockAspectRatio = msoTrue    '<---- Lock the original width/height ratio
        .Left = 0    '<---- Very left of sheet
        .Top = 0    '<---- Very top of sheet
        .Width = Columns(10).Left    '<---- 9 Columns wide
        .Name = "Picture 1"
    End With
ActiveSheet.Range("A1:I47").PrintOut
    'or
    'ActiveSheet.Cells(1, 1).Resize(ActiveSheet.Shapes("Picture 1").BottomRightCell.Row, ActiveSheet.Shapes("Picture 1").BottomRightCell.Column).PrintOut
End Sub

 

[sspatriots]

Going to give it a try right now. Thank you... I'll let you know how this turns out. It looks much cleaner than the stuff I was trying for certain.

 

[sspatriots]

Well that was ll I needed to get going again. Below is what I wound up with. I ended up creating a "Temp" worksheet with another macro in order to do everything on from your code and then deleted it. Thanks so much for you help on this.

Sub AddTempWSCust()
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error Resume Next
    Set ws = Worksheets("Temp")
    If Err.Number = 9 Then
        Set ws = Worksheets.Add(After:=Sheets(Worksheets.Count))
        ws.Name = "Temp"
        ws.Columns.Width = "2"
        
    Else
        
        Worksheets("Temp").Activate

    End If
    
    With ws
        
        PrintJobStatus4Cust
        
        ws.Shapes("Picture 1").Delete
        
    End With
    
    Worksheets("Temp").Delete
        
    Worksheets("Quick Search Job Status").Activate

    NumLockCorrector
        
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
        
End Sub

and then...

Sub PrintJobStatus4Cust()
Dim sShape As Picture
Set sShape = Worksheets("Temp").Pictures.Insert("C:\Folder Name Here\Picture Name Including Extension Here")
    
    With sShape
        .ShapeRange.LockAspectRatio = msoTrue    '<---- Lock the original width/height ratio
        .Left = 0   '<---- Very left of sheet
        .Top = 0    '<---- Very top of sheet
        .Width = Columns(24).Left    '<---- 9 Columns wide
        .Name = "Picture 1"
    End With
    
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .LeftMargin = Application.CentimetersToPoints(2#)
        .RightMargin = Application.CentimetersToPoints(0.5)
        .TopMargin = Application.CentimetersToPoints(1.5)
        .BottomMargin = Application.CentimetersToPoints(0.5)
        .HeaderMargin = Application.CentimetersToPoints(0.2)
        .FooterMargin = Application.CentimetersToPoints(0.2)
        .PaperSize = xlPaperLetter
        .Orientation = xlPortrait 'xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
    ActiveSheet.Range("A1:W51").PrintOut
    'ActiveSheet.Range("A1:W32").PrintPreview
    
    'or    'ActiveSheet.Cells(1, 1).Resize(ActiveSheet.Shapes("Picture 1").BottomRightCell.Row, ActiveSheet.Shapes("Picture 1").BottomRightCell.Column).PrintOut

    'or    'ActiveSheet.Cells(1, 1).Resize(ActiveSheet.Shapes("Picture 1").BottomRightCell.Row, ActiveSheet.Shapes("Picture 1").BottomRightCell.Column).PrintPreview

End Sub

 

[jolivanes]

Thanks for the update and good luck.