run to the last set of cells

PIsabel

Board Regular
Joined
Feb 4, 2014
Messages
126
Office Version
  1. 365
Platform
  1. Windows
Hello.
I need to run this code every 4 lines.
The sheets have either 4, 8, 16 or hundreds of lines but always in sets of 4 for each table.
Someone help me?




VBA Code:
Sub Range_To_Image()
  Dim objChrt As Chart
  Dim rngImage As Range
  Dim strFile As String

 
  On Error GoTo ErrExit

  With Sheets("folha1") 'Tabellenname - Anpassen!

    Set rngImage = .Range("A2:C5")

    rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    strFile = "C:\Users\Utilizador\Documents\. enviar\haus.jpg" 'Pfad und Dateiname für das Bild

    Set objChrt = .ChartObjects.Add(rngImage.Left, rngImage.Top, rngImage.Width, rngImage.Height).Chart

    With objChrt
        .Parent.Activate 'to avoid exporting an empty file
        .ChartArea.Format.Line.Visible = msoFalse 'remove border from chart
        .Paste
        .Export strFile
        .Parent.Delete
    End With

  End With

ErrExit:
  Set objChrt = Nothing
  Set rngImage = Nothing
 

End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Ex:
Set rngImage = .Range("A2:C5")
Set rngImage = .Range("A6:C10")
Set rngImage = .Range("A11:C15")

and save the file with the code name in:
Ex:
strFile = "C:\Users\Utilizador\Documents\. enviar\range("C2") & ".jpg"
strFile = "C:\Users\Utilizador\Documents\. enviar\range("C6") & ".jpg"
strFile = "C:\Users\Utilizador\Documents\. enviar\range("C11") & ".jpg"
 
Upvote 0
This is my sheet
 

Attachments

  • _9987.jpg
    _9987.jpg
    60.6 KB · Views: 16
Upvote 0
Set rngImage = .Range("A2:C5")
Set rngImage = .Range("A6:C10")
Set rngImage = .Range("A11:C15")

and save the file with the code name in:
Ex:
strFile = "C:\Users\Utilizador\Documents\. enviar\range("C2") & ".jpg"
strFile = "C:\Users\Utilizador\Documents\. enviar\range("C6") & ".jpg"
strFile = "C:\Users\Utilizador\Documents\. enviar\range("C11") & ".jpg"
That does not match your description or your image example.
It looks like it should be 2, 6, 10, not 2, 6, 11 (which is not every 4 rows).

If your want to start with row 2 and go every 4 rows until you get to the end of the data in column C, you could do something like this:
VBA Code:
'Find last row with data in column C
Dim lr as Long
lr = Cells(Rows.Count, "C").End(xlUp).Row

'Loop through all rows starting with row 2, skipping 4 rows at a time to the end of the data
Dim r as Long
For r = 2 to lr Step 4
'   Build range
    Set rngImage = .Range("A" & r & ":C" & r + 3)
'   Build file name
    strFile = "..." & Range("C" & r) & ".jpg"
 
Upvote 1
Solution
My mistake, I didn't do the math right.
But you still managed to do exactly what I needed.
Thank you very much








That does not match your description or your image example.
It looks like it should be 2, 6, 10, not 2, 6, 11 (which is not every 4 rows).

If your want to start with row 2 and go every 4 rows until you get to the end of the data in column C, you could do something like this:
VBA Code:
'Find last row with data in column C
Dim lr as Long
lr = Cells(Rows.Count, "C").End(xlUp).Row

'Loop through all rows starting with row 2, skipping 4 rows at a time to the end of the data
Dim r as Long
For r = 2 to lr Step 4
'   Build range
    Set rngImage = .Range("A" & r & ":C" & r + 3)
'   Build file name
    strFile = "..." & Range("C" & r) & ".jpg"
 
Upvote 0
You are welcome.
Glad I was able to help!
 
Upvote 1

Forum statistics

Threads
1,223,247
Messages
6,171,007
Members
452,374
Latest member
keccles

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