Insérer saut de page avant valeur Fermé

Question

Bonjour,
J'ai mis cette macro dans mon fichier:

Sub saut()'' Macro saut de page'For Each Cell In Range("A:A")    If Cell.Value = "Go" Then    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell    End IfNextEnd Submais les sauts de page se mettent n'importe où et pas au-dessus des valeurs "Go" comme souhaité 
Si je remplace "ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell" par msgbox = "tartempion", ça marche. C'est sur cette ligne dque le débogueur m'indique un problème et arrête la macro.
Avez-vous une idée du problème ? 


Configuration: Windows 7 / Internet Explorer 8.0

Mike-31 · Answer

Bonjour,

dans un module colle ce code

 Option Explicit

    Dim M As Range
    Dim i As Integer
    Dim k, e As String

Sub SautDePageAvant_Go()
On Error Resume Next
    Application.ScreenUpdating = False
    With ActiveSheet
    Set M = .Columns(1).Find("Go")
    If M Is Nothing Then Exit Sub
    e = M.Address
    Do
    .HPageBreaks.Add M 
    Set M = .Columns(1).FindNext(M)
    Loop While Not M Is Nothing And M.Address <> e
    End With
    Application.ScreenUpdating = True
End Sub


et peut être auras tu besoin d'un code pour supprimer les sauts, dans ce cas ajoute ce code

Sub supprimeSautPage()
On Error Resume Next
    k = ActiveSheet.HPageBreaks.Count
    For i = 1 To k
    ActiveSheet.HPageBreaks(1).Delete
    Next
End Sub

 
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Guy_L · Answer

Merci

Dans ma macro, il manquait juste cell.select

Sub saut()
'
' Macro saut de page
'
For Each Cell In Range("A:A")
If Cell.Value = "Go" Then
cell.select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
Next
End Sub

merci quand même

Mike-31 · Answer

Re,

ta macro tourne mal, dans le même ordre d'idée teste ce code

Sub Saut_Page_Avant_Go()
    On Error Resume Next
    Dim i As Variant
    On Error Resume Next
    Application.ScreenUpdating = False
    For i = 1 To 50
    If Range("A" & i) = "Go" Then ActiveSheet.HPageBreaks.Add Before:=Range("A" & i)
    Next
    Application.ScreenUpdating = True
End Sub


et pour supprimer tes sauts

Sub supprimeSautPage()
On Error Resume Next
ActiveSheet.ResetAllPageBreaks 'sup tous les sauts
End Sub

Guy_L · Answer

"ta macro tourne mal" ah ? chez moi ça marche bien
Qu'est-ce qui ne va pas ?

Merci pour tout le reste ;-)

Mike-31 · Answer

Re,

elle est lente, tourne en 0,27 à 0,30 seconde mon dernier code entre 0,03 et 0,05 seconde 

teste ton code 

Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
                    Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
                    Sub ChronomètrerUnCode()
                    Dim Debut As Currency, Fin As Currency, Freq As Currency
                    QueryPerformanceCounter Debut

                   call saut 'appelle la macro

                    QueryPerformanceCounter Fin
                    QueryPerformanceFrequency Freq
                    MsgBox "Durée de la procédure = " & Format(((Fin - Debut) / Freq), "0.00") & " s"
                    End Sub

Insérer saut de page avant valeur

5 réponses

Discussions similaires