Excel VB Copy & Print Range in Bulk

orion23 · Mar 6th 2016

Hi excel guru,
Need some help, i need to run a project to copy data (sales & outstanding) on daily basis and later print the summary range as jpeg file as output.

I have figured out how to copy and print them, now i am stuck in the process of how to print them in bulk at one go, ie. let say i have 40 accounts to process daily, i want the VB to match the account# in tab sales & outstanding, and output each of the 40 accounts as individual jpeg file.

i have attached the file here for better understanding

where am i now and cracking my head, would appreciate you help.

Thank you.

Raha · Mar 6th 2016

Re: Excel VB Copy & Print Range in Bulk

Is this how you wanted..?

Code

Sub test()
    Dim A As Variant, i As Long, dic As Object, n As Long, y As Variant
    
    Set dic = CreateObject("Scripting.dictionary")
    A = Worksheets("sales").Cells(1).CurrentRegion.Value
    
    For i = 2 To UBound(A, 1)
        If Not dic.exists(A(i, 1)) Then
            Set dic(A(i, 1)) = CreateObject("Scripting.dictionary")
        End If
        If Not dic(A(i, 1)).exists(A(i, 2)) Then
            dic(A(i, 1))(A(i, 2)) = VBA.Array(A(i, 1), A(i, 2), A(i, 3), A(i, 4), Empty)
        Else
            w = dic(A(i, 1))(A(i, 2))
            w(3) = w(3) + A(i, 4)
            dic(A(i, 1))(A(i, 2)) = w
        End If
    Next
    
    A = Worksheets("outstanding").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(A, 1)
        If dic.exists(A(i, 1)) Then
            If dic(A(i, 1)).exists(A(i, 2)) Then
                w = dic(A(i, 1))(A(i, 2))
                w(4) = w(4) + A(i, 4)
                dic(A(i, 1))(A(i, 2)) = w
            End If
        End If
    Next
    
    y = dic.items
    With Sheets("summary")
        .Cells(4, 1).CurrentRegion.Offset(1).ClearContents
        For i = 0 To dic.count - 1
            With .Cells(5, 1).Offset(n).Resize(y(i).count, 5)
                .Value = Application.Transpose(Application.Transpose(y(i).items))
            End With
            n = n + y(i).count
        Next
        .Cells(4, 1).CurrentRegion.Borders.Weight = 2
    End With
End Sub

Display More

orion23 · Mar 6th 2016

Re: Excel VB Copy & Print Range in Bulk

Hi Raha,
Thanks for your reply, sorry maybe my previous explanation not clear, i want to print the summary tab (range A4:E5) as jpeg for each individual account#, if i got 40 account#, i want to have 40 jpeg file, example attached

[ATTACH=CONFIG]68490[/ATTACH][ATTACH=CONFIG]68491[/ATTACH].

so let say now i can use summary tab data as the main data source, next is create a print format (A4:E5) to print each individual account# as jpeg.

each of jpeg file name based on account# in cell A5 and save in drive D.

Any idea how to do it?

Thank you so much.

orion23 · Mar 6th 2016

Re: Excel VB Copy & Print Range in Bulk

Hi,

I attached the xlsm file, module 1 is the test(), module 2 is the print jpeg.

would appreciate your help.

Raha · Mar 6th 2016

Re: Excel VB Copy & Print Range in Bulk

Please try the below code and keep me posted on the working status.

Code

Sub test()
    Dim A As Variant, i As Long, dic As Object, n As Long, y As Variant, Nm As Range, e As Variant, sht As Worksheet




    Set dic = CreateObject("Scripting.dictionary")
    A = Worksheets("sales").Cells(1).CurrentRegion.Value




    For i = 2 To UBound(A, 1)
        If Not dic.exists(A(i, 1)) Then
            Set dic(A(i, 1)) = CreateObject("Scripting.dictionary")
        End If
        If Not dic(A(i, 1)).exists(A(i, 2)) Then
            dic(A(i, 1))(A(i, 2)) = VBA.Array(A(i, 1), A(i, 2), A(i, 3), A(i, 4), Empty)
        Else
            w = dic(A(i, 1))(A(i, 2))
            w(3) = w(3) + A(i, 4)
            dic(A(i, 1))(A(i, 2)) = w
        End If
    Next




    A = Worksheets("outstanding").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(A, 1)
        If dic.exists(A(i, 1)) Then
            If dic(A(i, 1)).exists(A(i, 2)) Then
                w = dic(A(i, 1))(A(i, 2))
                w(4) = w(4) + A(i, 4)
                dic(A(i, 1))(A(i, 2)) = w
            End If
        End If
    Next
    
    On Error Resume Next
    Set sht = Sheets("Test")
    If sht Is Nothing Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Test"
        Set sht = Sheets("Test")
    End If
    
    y = dic.items
    With Sheets("summary")
        .Activate
        .Cells(4, 1).CurrentRegion.Offset(1).ClearContents
        For i = 0 To dic.Count - 1
            With .Cells(5, 1).Offset(n).Resize(y(i).Count, 5)
                .Value = Application.Transpose(Application.Transpose(y(i).items))
            End With
            n = n + y(i).Count
        Next
        .Cells(4, 1).CurrentRegion.Borders.Weight = 2
        For Each e In dic.keys()
            .Range("A4:E" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter 1, e
            On Error Resume Next
            Set Nm = .AutoFilter.Range.Offset(0, 0).Resize(.AutoFilter.Range.Rows.Count, .AutoFilter.Range.Columns.Count) _
            .SpecialCells(xlCellTypeVisible)
            Nm.Copy sht.Range("A1")
            With sht
                .Activate
                .Range("A1").CurrentRegion.Columns.AutoFit
                Set Nm = .Range("A1").CurrentRegion
                Nm.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
                With .ChartObjects.Add(Left:=Nm.Left, Top:=Nm.Top, Width:=Nm.Width, Height:=Nm.Height)
                    .Name = "TempArea"
                    .Activate
                    ActiveChart.Paste
                    .Parent.ChartObjects("TempArea").Chart.Export "D:\" & e & ".jpg"
                    .Parent.ChartObjects("TempArea").Delete
                End With
                .Range("A1").CurrentRegion.ClearContents
            End With
        Next
        .AutoFilterMode = False
    End With
    Application.DisplayAlerts = False
        sht.Delete
        Sheets("summary").Activate
    Application.DisplayAlerts = True
End Sub

Display More

orion23 · Mar 6th 2016

Re: Excel VB Copy & Print Range in Bulk

Hi Raha,
Thank you so much, it's working great!! awesome!!

i am looking thru the vb code and try to understand them, thanks and appreciate your help.

Raha · Mar 6th 2016

Re: Excel VB Copy & Print Range in Bulk

You are welcome.

orion23 · Mar 7th 2016

Re: Excel VB Copy & Print Range in Bulk

Hi Raha,
Can you share which part of vb code to print the range as jpg?

if i want to enlarge the area of print area (eg. A4:E8), only show one record/account (eg. account #123, 456, 789,....) , below the record i will add some text on my own.

so the vb will run a list from top to bottom of all the account #

i had read thru your code and a kinda confused.

Thanks again.

orion23 · Mar 7th 2016

Re: Excel VB Copy & Print Range in Bulk

Hi Raha,

Need your advice below

pls have a look on the excel file - tab "pic_format", this is the template i want to print as jpeg from A1:F8.

i need to copy 2 variables - sales person name and sales data from a summary list, assuming now i already copied all data, next is to export this template to jpeg based on various records data, i could have many records like 50, 100.....

so i want to sort out the export jpeg vb code here, would appreciate you help.

thanks.

Raha · Mar 7th 2016

Re: Excel VB Copy & Print Range in Bulk

Just added the below line after with sht .activate, please see the attached workbook.
And change the font size as per your requirement.

Code

.Cells(1).CurrentRegion.Font.Size = "18"

Thank you,

Regards,
Rahaman.

orion23 · Mar 8th 2016

Re: Excel VB Copy & Print Range in Bulk

Hi Raha,
Thanks but I didn't ask to change the font size bro, can you pls check thread#9 above.

Thanks.

Raha · Mar 8th 2016

Re: Excel VB Copy & Print Range in Bulk

To print sheet "pic_format" Range("A1:F8") as jpg use the below code. or if you want the jpg in large size then increase the font size.
and Please try to adopt the code as per your requirement.

Code

Sub print_JPG()
    Dim Nm As Range, Acct As String
    With Sheets("pic_format")
        .Activate
        Acct = .Range("A4").Value
        Set Nm = .Range("A1:F8")
        Nm.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        With .ChartObjects.Add(Left:=Nm.Left, Top:=Nm.Top, Width:=Nm.Width, Height:=Nm.Height)
            .Name = "TempArea"
            .Activate
            ActiveChart.Paste
            .Parent.ChartObjects("TempArea").Chart.Export "D:\" & Acct & ".jpg"
            .Parent.ChartObjects("TempArea").Delete
        End With
    End With
End Sub

Display More

orion23 · Mar 8th 2016

Re: Excel VB Copy & Print Range in Bulk

Hi Raha,

thanks bro.

one more question if i have a long list (100 records in sheet 'summary' and want to copy each of them in this template and print as jpg, is it something like loop thru each of the record and copy, print as jpeg, so can pls enlighten me how to implement this?

Thanks

Excel VB Copy & Print Range in Bulk

Participate now!

Share