VBA to print

KlausW · Feb 11, 2023

Hello

I have a challenge.

I use this VBA code to print different pages and I put X next to the sheet name that I like to be printed in the sheets Stamdata (yellow) see picture 1. It works as it shall. Now I would like to insert 2 new sheets (red) before the sheets Stamdata (yellow) see image 2. But then the VBA code does not work, it does not follow the X.

Any help will be appreciated.

Best Regards

Klaus W

VBA Code:

Sub Rektangelafrundedehjørner4_Klik()

Dim intRaekke As Integer

Dim SidsteSide As Integer

Dim SiderUdskrevet As Integer

SiderUdskrevet = 0

On Error GoTo fejl:

If Worksheets.Count < 1 Then

MsgBox "Der er ingen sider at udskrive?"

End If

For intRaekke = 5 To Worksheets.Count '<--Rettet til 5. Print første

'Tilføjet - 2 for at læse X fra række 3 i Stamdata

If Cells(intRaekke - 2, 2).Value = "x" Or _

Cells(intRaekke - 2, 2).Value = "X" Then

SidsteSide = Sheets(intRaekke).Range("G1")

If Not (IsNumeric(SidsteSide)) Or SidsteSide = 0 Then

MsgBox Worksheets(intRaekke).Name & " Celle G1 Er ikke et tal eller > 0?"

Exit Sub

End If

Sheets(intRaekke).PrintOut From:=1, To:=SidsteSide

SiderUdskrevet = SiderUdskrevet + 1

End If

Next

If SiderUdskrevet = 0 Then

MsgBox "Ingen sider valgt til udskrift."

End If

fejl:

If Err.Number = 1004 Then

MsgBox "Du skal indtaste et tal på Fane" & intRaekke & " celle G1"

End If

End Sub

HaHoBe · Feb 12, 2023

Hi KlausW,

both your pictures show the same scenario.

According to what I understand the order of the worksheets in the workbook after inserting 2 ws at the beginning: 2 ws to be printed, 2 sheets not to be printed, 6 ws more to be printed.

MrE_1229672_1702B11_vba to print_230212.xlsm

A

B

C

2

Sheets Name

X for print

Index

3

1

5

4

2

6

5

3

x

7

6

4

8

7

5

9

8

6

10

9

7

1

10

8

x

2

Stamdata

VBA Code:

Sub Rektangelafrundedehjørner4_Klik()
' https://www.mrexcel.com/board/threads/vba-to-print.1229672/
Dim intRaekke As Integer
Dim SidsteSide As Integer
Dim SiderUdskrevet As Integer
Dim lngWsIndex As Long         'will be used for Index of worksheets

SiderUdskrevet = 0

On Error GoTo fejl:
If Worksheets.Count < 1 Then
  MsgBox "Der er ingen sider at udskrive?"
End If

intRaekke = 5
With Worksheets("Stamdata")
  Do While .Cells(intRaekke - 2, 1).Value <> ""
    'Tilføjet - 2 for at læse X fra række 3 i Stamdata
    If LCase(.Cells(intRaekke - 2, 2).Value) = "x" Then
      Select Case intRaekke
        'rows in Stamdata referencing ws with Index 1 and 2: subtract 10 from intRaekke as you start with Index 5 at Row 3
        Case 11 To 12
          lngWsIndex = intRaekke - 10
        Case Else
          lngWsIndex = intRaekke
      End Select
      SidsteSide = Worksheets(lngWsIndex).Range("G1")
      If Not (IsNumeric(SidsteSide)) Or SidsteSide = 0 Then
        MsgBox Worksheets(lngWsIndex).Name & " Celle G1 Er ikke et tal eller > 0?"
        Exit Sub
      End If
      Worksheets(lngWsIndex).PrintOut From:=1, To:=SidsteSide
      SiderUdskrevet = SiderUdskrevet + 1
    End If
    intRaekke = intRaekke + 1
  Loop
End With

If SiderUdskrevet = 0 Then
  MsgBox "Ingen sider valgt til udskrift."
End If

fejl:
If Err.Number = 1004 Then
  MsgBox "Du skal indtaste et tal på Fane" & intRaekke & " celle G1"
End If

End Sub

Holger

KlausW · Feb 12, 2023

HaHoBe said:

Hi KlausW,

both your pictures show the same scenario.

According to what I understand the order of the worksheets in the workbook after inserting 2 ws at the beginning: 2 ws to be printed, 2 sheets not to be printed, 6 ws more to be printed.

MrE_1229672_1702B11_vba to print_230212.xlsm

A

B

C

2

Sheets Name

X for print

Index

3

1

5

4

2

6

5

3

x

7

6

4

8

7

5

9

8

6

10

9

7

1

10

8

x

2

Stamdata

VBA Code:

Sub Rektangelafrundedehjørner4_Klik()
' https://www.mrexcel.com/board/threads/vba-to-print.1229672/
Dim intRaekke As Integer
Dim SidsteSide As Integer
Dim SiderUdskrevet As Integer
Dim lngWsIndex As Long         'will be used for Index of worksheets

SiderUdskrevet = 0

On Error GoTo fejl:
If Worksheets.Count < 1 Then
  MsgBox "Der er ingen sider at udskrive?"
End If

intRaekke = 5
With Worksheets("Stamdata")
  Do While .Cells(intRaekke - 2, 1).Value <> ""
    'Tilføjet - 2 for at læse X fra række 3 i Stamdata
    If LCase(.Cells(intRaekke - 2, 2).Value) = "x" Then
      Select Case intRaekke
        'rows in Stamdata referencing ws with Index 1 and 2: subtract 10 from intRaekke as you start with Index 5 at Row 3
        Case 11 To 12
          lngWsIndex = intRaekke - 10
        Case Else
          lngWsIndex = intRaekke
      End Select
      SidsteSide = Worksheets(lngWsIndex).Range("G1")
      If Not (IsNumeric(SidsteSide)) Or SidsteSide = 0 Then
        MsgBox Worksheets(lngWsIndex).Name & " Celle G1 Er ikke et tal eller > 0?"
        Exit Sub
      End If
      Worksheets(lngWsIndex).PrintOut From:=1, To:=SidsteSide
      SiderUdskrevet = SiderUdskrevet + 1
    End If
    intRaekke = intRaekke + 1
  Loop
End With

If SiderUdskrevet = 0 Then
  MsgBox "Ingen sider valgt til udskrift."
End If

fejl:
If Err.Number = 1004 Then
  MsgBox "Du skal indtaste et tal på Fane" & intRaekke & " celle G1"
End If

End Sub

Holger

Hello Holger, if you look at picture 2, I have colored the 2 inserted sheets red, and after that the VBA code does not work. And the VBA code you sent my do not work. Regards Klaus W

KlausW · Feb 12, 2023

I think the solution must be found in the line. If Worksheets.Count < 1 Then or For intRaekke = 5 To Worksheets.Count.

Regards Klaus W

HaHoBe · Feb 12, 2023

Hi Klaus,

you're right about the pictures - I did not catch that on my laptop.

Working with the Index (the position of the worksheets in the workbook) may be daring as users may drag around the sheets.

I hope this comes near to what your setup may look like with the registers with no colour to be treated for printout.

MrE_1229672_1702B11_vba to print_230212.xlsm

A

B

C

D

2

Sheets Name

X for print

Row Counter

Index

3

1

5

7

4

2

6

8

5

3

7

9

6

4

8

10

7

5

9

11

8

6

10

12

9

7

11

13

10

8

12

14

11

9

13

3

12

10

14

4

Stamdata

The numbers in Columns C and D are added just to explain how the Index numbers of the sheets are determined.

The code must be altered due to the new sheets adding to the collection of worksheets:

VBA Code:

Sub Rektangelafrundedehjørner4_Klik()
' https://www.mrexcel.com/board/threads/vba-to-print.1229672/
Dim intRaekke As Integer
Dim SidsteSide As Integer
Dim SiderUdskrevet As Integer
Dim lngWsIndex As Long         'will be used for Index of worksheets

SiderUdskrevet = 0

On Error GoTo fejl:
If Worksheets.Count < 1 Then
  MsgBox "Der er ingen sider at udskrive?"
End If

intRaekke = 5
With Worksheets("Stamdata")
  Do While .Cells(intRaekke - 2, 1).Value <> ""
    'Tilføjet - 2 for at læse X fra række 3 i Stamdata
    If LCase(.Cells(intRaekke - 2, 2).Value) = "x" Then
      Select Case intRaekke
        'rows in Stamdata referencing ws with Index 1 and 2: subtract 10 from intRaekke as you start with Index 5 at Row 3
        Case 13 To 14
          lngWsIndex = intRaekke - 10
        Case Else
          lngWsIndex = intRaekke + 2
      End Select
      SidsteSide = Worksheets(lngWsIndex).Range("G1")
      If Not (IsNumeric(SidsteSide)) Or SidsteSide = 0 Then
        MsgBox Worksheets(lngWsIndex).Name & " Celle G1 Er ikke et tal eller > 0?"
        Exit Sub
      End If
      Worksheets(lngWsIndex).PrintOut From:=1, To:=SidsteSide
      SiderUdskrevet = SiderUdskrevet + 1
    End If
    intRaekke = intRaekke + 1
  Loop
End With

If SiderUdskrevet = 0 Then
  MsgBox "Ingen sider valgt til udskrift."
End If

fejl:
If Err.Number = 1004 Then
  MsgBox "Du skal indtaste et tal på Fane" & intRaekke & " celle G1"
End If

End Sub

Holger

KlausW · Feb 12, 2023

HaHoBe said:
Hi Klaus,

you're right about the pictures - I did not catch that on my laptop.

Working with the Index (the position of the worksheets in the workbook) may be daring as users may drag around the sheets.

View attachment 85235

I hope this comes near to what your setup may look like with the registers with no colour to be treated for printout.

MrE_1229672_1702B11_vba to print_230212.xlsm
A B C D
2 Sheets Name X for print Row Counter Index
3 1 5 7
4 2 6 8
5 3 7 9
6 4 8 10
7 5 9 11
8 6 10 12
9 7 11 13
10 8 12 14
11 9 13 3
12 10 14 4
Stamdata

The numbers in Columns C and D are added just to explain how the Index numbers of the sheets are determined.

The code must be altered due to the new sheets adding to the collection of worksheets:

VBA Code:

Sub Rektangelafrundedehjørner4_Klik() ' https://www.mrexcel.com/board/threads/vba-to-print.1229672/ Dim intRaekke As Integer Dim SidsteSide As Integer Dim SiderUdskrevet As Integer Dim lngWsIndex As Long 'will be used for Index of worksheets SiderUdskrevet = 0 On Error GoTo fejl: If Worksheets.Count < 1 Then MsgBox "Der er ingen sider at udskrive?" End If intRaekke = 5 With Worksheets("Stamdata") Do While .Cells(intRaekke - 2, 1).Value <> "" 'Tilføjet - 2 for at læse X fra række 3 i Stamdata If LCase(.Cells(intRaekke - 2, 2).Value) = "x" Then Select Case intRaekke 'rows in Stamdata referencing ws with Index 1 and 2: subtract 10 from intRaekke as you start with Index 5 at Row 3 Case 13 To 14 lngWsIndex = intRaekke - 10 Case Else lngWsIndex = intRaekke + 2 End Select SidsteSide = Worksheets(lngWsIndex).Range("G1") If Not (IsNumeric(SidsteSide)) Or SidsteSide = 0 Then MsgBox Worksheets(lngWsIndex).Name & " Celle G1 Er ikke et tal eller > 0?" Exit Sub End If Worksheets(lngWsIndex).PrintOut From:=1, To:=SidsteSide SiderUdskrevet = SiderUdskrevet + 1 End If intRaekke = intRaekke + 1 Loop End With If SiderUdskrevet = 0 Then MsgBox "Ingen sider valgt til udskrift." End If fejl: If Err.Number = 1004 Then MsgBox "Du skal indtaste et tal på Fane" & intRaekke & " celle G1" End If End Sub

Holger

Hi HaHoBe thanks it is just as I want. Thanks a lot. Have a nice evening. Best regards from Denmark Klaus W

HaHoBe · Feb 12, 2023

Hi KlausW,

maybe you can test this slightly different approach as well as that will work with the actual names for the worksheets.

In ThisWorkbook you need to use (or amend to)

VBA Code:

Private Sub Workbook_Open()
  FillStamdata
End Sub

So any time the workbook is opened the code for procedure FillStamdata will run.

Behind sheet Stamdata you should use (or amend)

VBA Code:

Private Sub Worksheet_Activate()
  FillStamdata
End Sub

This will run the procedure any time you switch to sheet Stamdata.

The procedure should be placed in a standard module, please change the name for the last sheet as I named it AddLastName:

VBA Code:

Sub FillStamdata()
Dim ws As Worksheet

Application.ScreenUpdating = False
With Worksheets("Stamdata")
  'Clear the entries form Row 3 on in Columns A and B
  .Range("A3:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).ClearContents
 
  For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
      Case "Materiale", "Master", "AddLastName", .Name
        'we don*t want these names as they are not to be printed
      Case Else
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = ws.Name
    End Select
  Next ws
End With
Application.ScreenUpdating = True
End Sub

And the main procedure needs to be updated as well to

VBA Code:

Sub Rektangelafrundedehjørner4_Klik()
' https://www.mrexcel.com/board/threads/vba-to-print.1229672/
'Update: uses the names of the worksheets instead the Index in the workbook
Dim intRaekke As Integer
Dim SidsteSide As Integer
Dim SiderUdskrevet As Integer
Dim wsPrint As Worksheet

SiderUdskrevet = 0

On Error GoTo fejl:
If Worksheets.Count < 1 Then
  MsgBox "Der er ingen sider at udskrive?"
End If

With Worksheets("Stamdata")
  For intRaekke = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
    'Tilføjet - 2 for at læse X fra række 3 i Stamdata
    If LCase(.Cells(intRaekke, 2).Value) = "x" Then
      Set wsPrint = Worksheets(.Cells(intRaekke, 1))
      SidsteSide = wsPrint.Range("G1")
      If Not (IsNumeric(SidsteSide)) Or SidsteSide = 0 Then
        MsgBox wsPrint.Name & " Celle G1 Er ikke et tal eller > 0?"
        GoTo fejl
      End If
      wsPrint.PrintOut From:=1, to:=SidsteSide
      SiderUdskrevet = SiderUdskrevet + 1
    End If
  Next intRaekke
End With

If SiderUdskrevet = 0 Then
  MsgBox "Ingen sider valgt til udskrift."
End If

fejl:
If Err.Number = 1004 Then
  MsgBox "Du skal indtaste et tal på Fane" & intRaekke & " celle G1"
End If
Set wsPrint = Nothing
End Sub

Have fun

Holger

KlausW · Feb 13, 2023

HaHoBe said:

Hi KlausW,

maybe you can test this slightly different approach as well as that will work with the actual names for the worksheets.

In ThisWorkbook you need to use (or amend to)

VBA Code:

Private Sub Workbook_Open()
  FillStamdata
End Sub

So any time the workbook is opened the code for procedure FillStamdata will run.

Behind sheet Stamdata you should use (or amend)

VBA Code:

Private Sub Worksheet_Activate()
  FillStamdata
End Sub

This will run the procedure any time you switch to sheet Stamdata.

The procedure should be placed in a standard module, please change the name for the last sheet as I named it AddLastName:

VBA Code:

Sub FillStamdata()
Dim ws As Worksheet

Application.ScreenUpdating = False
With Worksheets("Stamdata")
  'Clear the entries form Row 3 on in Columns A and B
  .Range("A3:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).ClearContents
 
  For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
      Case "Materiale", "Master", "AddLastName", .Name
        'we don*t want these names as they are not to be printed
      Case Else
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = ws.Name
    End Select
  Next ws
End With
Application.ScreenUpdating = True
End Sub

And the main procedure needs to be updated as well to

VBA Code:

Sub Rektangelafrundedehjørner4_Klik()
' https://www.mrexcel.com/board/threads/vba-to-print.1229672/
'Update: uses the names of the worksheets instead the Index in the workbook
Dim intRaekke As Integer
Dim SidsteSide As Integer
Dim SiderUdskrevet As Integer
Dim wsPrint As Worksheet

SiderUdskrevet = 0

On Error GoTo fejl:
If Worksheets.Count < 1 Then
  MsgBox "Der er ingen sider at udskrive?"
End If

With Worksheets("Stamdata")
  For intRaekke = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
    'Tilføjet - 2 for at læse X fra række 3 i Stamdata
    If LCase(.Cells(intRaekke, 2).Value) = "x" Then
      Set wsPrint = Worksheets(.Cells(intRaekke, 1))
      SidsteSide = wsPrint.Range("G1")
      If Not (IsNumeric(SidsteSide)) Or SidsteSide = 0 Then
        MsgBox wsPrint.Name & " Celle G1 Er ikke et tal eller > 0?"
        GoTo fejl
      End If
      wsPrint.PrintOut From:=1, to:=SidsteSide
      SiderUdskrevet = SiderUdskrevet + 1
    End If
  Next intRaekke
End With

If SiderUdskrevet = 0 Then
  MsgBox "Ingen sider valgt til udskrift."
End If

fejl:
If Err.Number = 1004 Then
  MsgBox "Du skal indtaste et tal på Fane" & intRaekke & " celle G1"
End If
Set wsPrint = Nothing
End Sub

Have fun

Holger

Thanks KW

VBA to print

KlausW

Active Member

Attachments

Excel Facts

HaHoBe

Well-known Member

KlausW

Active Member

KlausW

Active Member

HaHoBe

Well-known Member

KlausW

Active Member

HaHoBe

Well-known Member

KlausW

Active Member

Similar threads

Forum statistics

Share this page

VBA to print

Active Member

Attachments

Excel Facts

Well-known Member

Active Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock