Harde horizontale pagina einde automatisch plaatsen na zoeken celwaarde dmv VBA

[Josno]

Is het mogelijk om via VBA de voor ingestelde pagina einde(s) te wissen en aan de hand van een celwaarde "printdatum:" welke in het excel bestand meerdere malen voorkomt. Automatisch een harde horizontale pagina einde in te voegen na deze celwaarde?

 

[HSV]

Misschien dat je hier verder mee kan.

Sub HSV()
 Dim  i As Long, c As Variant, firstaddress As Variant
 With Sheets("Blad1")
 
 For i = 1 To 10 'even voor het gemak ingesteld op 10 (aantal paginaeinden)
  On Error Resume Next
   .HPageBreaks.Item(i).Delete
  Next i
    Set c = .Columns(1).Find("printdatum")
     If Not c Is Nothing Then
           firstaddress = c.Address
    Do
       .HPageBreaks.Add c.Offset(1)
      Set c = .Columns(1).FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
 End With
End Sub

 

[Josno]

Dank je wel voor de snelle reactie de harde pagina eindes worden mooi geplaatst. Ik loop nog wel tegen één ding aan en dat zijn de automatische pagina eindes die blijven staan is het mogelijk om die te wissen of iets dergelijks? Anders krijg ik nog extra blanco paginas of pagina met een regel.

 

[Josno]

Misschien dat je hier verder mee kan.

Sub HSV()
 Dim  i As Long, c As Variant, firstaddress As Variant
 With Sheets("Blad1")
 
 For i = 1 To 10 'even voor het gemak ingesteld op 10 (aantal paginaeinden)
  On Error Resume Next
   .HPageBreaks.Item(i).Delete
  Next i
    Set c = Columns(1).Find("printdatum")
     If Not c Is Nothing Then
           firstaddress = c.Address
    Do
       .HPageBreaks.Add c.Offset(1)
      Set c = Columns(1).FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
 End With
End Sub

Dank je wel voor de snelle reactie de harde pagina eindes worden mooi geplaatst. Ik loop nog wel tegen één ding aan en dat zijn de automatische pagina eindes die blijven staan is het mogelijk om die te wissen of iets dergelijks? Anders krijg ik nog extra blanco paginas of pagina met een regel.

 

[HSV]

Probeer deze versie eens.

Sub HSV()
 Dim PB As Variant, i As Long, c As Variant, firstaddress As Variant
 With Sheets("Blad1")
  .Cells.SpecialCells(xlCellTypeVisible).PageBreak = xlNone
 Set c = .Columns(1).Find("printdatum")
     If Not c Is Nothing Then
           firstaddress = c.Address
    Do
       .HPageBreaks.Add c.Offset(1)
      Set c = .Columns(1).FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
 End With
End Sub

 

[Josno]

Opgelost

Probeer deze versie eens.

Sub HSV()
 Dim PB As Variant, i As Long, c As Variant, firstaddress As Variant
 With Sheets("Blad1")
  .Cells.SpecialCells(xlCellTypeVisible).PageBreak = xlNone
 Set c = .Columns(1).Find("printdatum")
     If Not c Is Nothing Then
           firstaddress = c.Address
    Do
       .HPageBreaks.Add c.Offset(1)
      Set c = .Columns(1).FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
 End With
End Sub

Sorry dat ik niet eerder heb gereageerd maar ik ben een paar dagen vrij geweest. Mijn harte dank voor de oplossing, ik zal de vraag op opgelost zetten