J'ai le code suivant que j'ai trouvé en recherchant sur Google le problème. Le problème avec ce code est qu'il écrase l'avant-dernier en-tête de section (et le pied de page bien que je n'ai besoin que de l'en-tête conservé) par celui de la dernière section, qui est le comportement par défaut (étrange) de Word.
Est y a-t-il une solution de contournement à cela dans VBA?
Voici le code qui a l'erreur inhérente:
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
Dim myheader As HeaderFooter
If ctr > 1 Then
With rng
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub
toute la plage de la dernière section est supprimée par le code et c'est le comportement requis. Le problème inhérent au comportement par défaut de Word est ce pour quoi j'avais besoin d'une solution de contournement dans le code VBA. On peut trouver des procédures manuelles complexes pour l'éviter, mais j'avais besoin d'une approche simple dans le code.
4 Réponses :
Le problème ici réside dans le fait que le saut de section contient les informations de section. Si vous le supprimez, la dernière section fait partie de la section précédente. L'astuce que j'utilise ci-dessous est de créer un saut de section continu au lieu d'un saut de page, puis de faire tout le reste:
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim NewEndOfDocument As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
If ctr > 1 Then
' Create a section break at the end of the second to last section
Set NewEndOfDocument = doc.Sections(ctr - 1).Range
NewEndOfDocument.EndOf wdSection, wdMove
doc.Sections.Add NewEndOfDocument, wdSectionContinuous
With rng
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub
Merci, c'est une solution de contournement intelligente. Mérite un vote positif. Bien que je veuille noter qu'avec cela, nous ne supprimons pas la dernière section, seulement les pages de celle-ci. Je cherchais une solution qui éliminerait le saut de section supplémentaire pour avoir un document propre. J'ai publié une solution de contournement maintenant en tant que réponse que j'ai trouvée pour résoudre le problème à l'aide de la propriété LinkToPrevious .
La suppression de la dernière section d'un document Word n'est pas une tâche facile.
Ce que vous devrez peut-être faire si les éléments sont différents entre les sections «avant-dernier» et «dernier» d'un document.
Assurez-vous que dans la dernière section, tout "lien vers un précédent" dans un en-tête ou un pied de page est défini sur faux
Copiez tous les en-têtes et pieds de page de l'avant-dernière section à la dernière section
Copiez les éléments de format de page pertinents de l'avant-dernière section dans la dernière section (format de papier, orientation, marges, etc.)
Récupère la plage de la dernière section du document. Déplacez la fin de la plage vers l'arrière jusqu'à ce que la valeur ascii soit> = 32.
Ensuite, vous pouvez supprimer en toute sécurité la plage ajustée de votre document sans aucun effet secondaire désagréable
Normalement, la suppression d'un saut de section fait que la section précédant le saut adopte la mise en page de la section suivante. La macro suivante fonctionne dans l'autre sens, sur plusieurs sauts de section (sélectionnés). Tous les problèmes courants de mise en page (marges, orientation de la page, colonnes de texte, en-têtes et pieds de page) sont résolus. Comme vous pouvez le voir en étudiant le code, ce n'est pas une tâche triviale de faire toutes ces choses.
Sub MergeSections()
Application.ScreenUpdating = False
Dim sPageHght As Single, sPageWdth As Single
Dim sHeaderDist As Single, sFooterDist As Single
Dim sTMargin As Single, sBMargin As Single
Dim sLMargin As Single, sRMargin As Single
Dim sGutter As Single, sGutterPos As Single
Dim lPaperSize As Long, lGutterStyle As Long
Dim lMirrorMargins As Long, lVerticalAlignment As Long
Dim lScnStart As Long, lScnDir As Long
Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long
Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean
Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean
Dim lOrientation As Long, oHdFt As HeaderFooter
Dim Sctn1 As Section, Sctn2 As Section
With Selection
If .Sections.Count = 1 Then
MsgBox "Selection does not span a Section break", vbExclamation
Exit Sub
End If
Set Sctn1 = .Sections.First: Set Sctn2 = .Sections.Last
With Sctn1.PageSetup
lPaperSize = .PaperSize
lGutterStyle = .GutterStyle
lOrientation = .Orientation
lMirrorMargins = .MirrorMargins
lScnStart = .SectionStart
lScnDir = .SectionDirection
lOddEvenHdFt = .OddAndEvenPagesHeaderFooter
lDiffFirstHdFt = .DifferentFirstPageHeaderFooter
lVerticalAlignment = .VerticalAlignment
sPageHght = .PageHeight
sPageWdth = .PageWidth
sTMargin = .TopMargin
sBMargin = .BottomMargin
sLMargin = .LeftMargin
sRMargin = .RightMargin
sGutter = .Gutter
sGutterPos = .GutterPos
sHeaderDist = .HeaderDistance
sFooterDist = .FooterDistance
bTwoPagesOnOne = .TwoPagesOnOne
bBkFldPrnt = .BookFoldPrinting
bBkFldPrnShts = .BookFoldPrintingSheets
bBkFldRevPrnt = .BookFoldRevPrinting
End With
With Sctn2.PageSetup
.GutterStyle = lGutterStyle
.MirrorMargins = lMirrorMargins
.SectionStart = lScnStart
.SectionDirection = lScnDir
.OddAndEvenPagesHeaderFooter = lOddEvenHdFt
.DifferentFirstPageHeaderFooter = lDiffFirstHdFt
.VerticalAlignment = lVerticalAlignment
.PageHeight = sPageHght
.PageWidth = sPageWdth
.TopMargin = sTMargin
.BottomMargin = sBMargin
.LeftMargin = sLMargin
.RightMargin = sRMargin
.Gutter = sGutter
.GutterPos = sGutterPos
.HeaderDistance = sHeaderDist
.FooterDistance = sFooterDist
.TwoPagesOnOne = bTwoPagesOnOne
.BookFoldPrinting = bBkFldPrnt
.BookFoldPrintingSheets = bBkFldPrnShts
.BookFoldRevPrinting = bBkFldRevPrnt
.PaperSize = lPaperSize
.Orientation = lOrientation
End With
With Sctn2
For Each oHdFt In .Footers
oHdFt.LinkToPrevious = Sctn1.Footers(oHdFt.Index).LinkToPrevious
If oHdFt.LinkToPrevious = False Then
Sctn1.Headers(oHdFt.Index).Range.Copy
oHdFt.Range.Paste
End If
Next
For Each oHdFt In .Headers
oHdFt.LinkToPrevious = Sctn1.Headers(oHdFt.Index).LinkToPrevious
If oHdFt.LinkToPrevious = False Then
Sctn1.Headers(oHdFt.Index).Range.Copy
oHdFt.Range.Paste
End If
Next
End With
While .Sections.Count > 1
.Sections.First.Range.Characters.Last.Delete
Wend
Set Sctn1 = Nothing: Set Sctn2 = Nothing
End With
Application.ScreenUpdating = True
End Sub
En examinant plus en détail cela par moi-même (j'ai dû résoudre le problème rapidement et je ne pouvais pas attendre), je suis arrivé à la même conclusion que celle indiquée dans le commentaire de @CindyMeister que lors de la suppression du dernier "saut de section" en fait, l'avant-dernière section est en cours de suppression, et les données et le formatage qui appartenaient jusqu'ici à la dernière section sont apparemment hérités par la nouvelle dernière section (c.-à-d. avant-dernière section précédente). Mais en réalité, la dernière section est restée et seul le saut de section a été supprimé, donc ce qui a été supprimé était l'avant-dernière section (et les pages réelles de la dernière section).
J'ai trouvé que le LinkToPrevious de l'objet HeaderFooter permet une approche simpliste pour "hériter" des paramètres de la section précédente.
Donc en ajoutant quelques lignes pour définir cette propriété sur true dans chaque instance, puis remettez-le en false , je peux obtenir le comportement requis de l'avant-dernière section en restant le même qu'auparavant.
(Veuillez noter que cela a fonctionné pour moi car j'avais simplement un texte différent dans l'en-tête principal, et je n'avais pas de mise en forme spéciale et autre. Mais je soupçonne que basé sur le fonctionnement du LinkToPrevious propriété c'est une panacée. Veuillez commenter si autrement.)
Voici les lignes pour définir la propriété:
Sub DeleteLastSection()
'Deletes last section of a document including
'the section break
Dim doc As Document
Dim rng As Range
Dim ctr As Integer
Set doc = ActiveDocument
ctr = doc.Sections.Count
Set rng = doc.Sections(ctr).Range
Dim myheader As HeaderFooter
If ctr > 1 Then
With rng
'Added lines to "inherit" the settings from the next-to-last section
for each hf in .Sections(1).Headers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
for each hf in .Sections(1).Footers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
.Select
.MoveStart Unit:=wdCharacter, Count:=-1
.Delete
End With
End If
End Sub
Le code de travail complet pour la progéniture:
for each hf in .Sections(1).Headers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
for each hf in .Sections(1).Footers
hf.LinkToPrevious = True
hf.LinkToPrevious = False
next
Contexte du problème, soutenant la contribution de @Sam (qui peut être incluse dans la réponse, si vous le souhaitez): Word a toujours, par défaut, une section. Cette section est associée à la dernière marque de paragraphe et ne peut être supprimée. Les nouvelles sections sont toujours créées avant la section d'origine. La mise en forme des sections est toujours "conservée" dans le saut de section suivant une section. Ainsi, la suppression du dernier saut de section visible conservera toujours la mise en forme de section de cette dernière section, pour laquelle il n'y a pas de saut de section visible.