vba: retourne le numéro de page à partir de la sélection.rechercher à l'aide de texte à partir de la matrice de
(Note: Voir ci-dessous pour solution).
J'ai essayé de récupérer les numéros de page à partir de pages de rubriques diverses résident dans un document word à l'aide de VBA. Mon code actuel renvoie soit à 2 ou 3, et non pas l'correctement associés à des numéros de page, en fonction de où et comment je l'utilise dans mon Sous.
astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)
For Each hds In astrHeadings
docSource.Activate
With Selection.Find
.Text = Trim$(hds)
.Forward = True
MsgBox hds & ":" & Selection.Information(wdActiveEndPageNumber), vbOKOnly
End With
Selection.Find.Execute
Next
docSource
est un document de test, j'ai mis en place avec 10 titres de plus de 3 pages. J'ai les titres extrait de l' getCrossReferenceItems
méthode à utiliser plus tard dans mon code.
Ce que je cherche est en boucle à travers les résultats de l' getCrossReferenceItems
méthode et l'utilisation de chacun d'eux dans une recherche d'objet sur docSource
et à partir de ce savoir à quelle page le résultat est sur. Les numéros de page seront ensuite utilisés dans une chaîne plus loin dans mon code. Cette chaîne, plus le numéro de page sera ajoutée à un document qui est créé au début de mes principaux sous, tout le reste fonctionne un régal mais cette segment de code.
Idéalement ce que j'ai besoin de ce segment à faire est de remplir un second tableau avec les numéros de page de chaque résultat de la recherche.
Problèmes Résolus
Merci Kevin vous avez été d'une grande aide ici, j'ai maintenant exactement ce dont j'ai besoin à partir de la sortie de ce Sub
.
docSource est un document de test, j'ai mis en place avec 10 titres de plus de 3 pages.
docOutline est un nouveau document qui va agir comme une Table des Matières du document.
J'ai eu à utiliser cette Sub
plus de Mot intégré dans la table des matières fonctions en raison:
-
J'ai plusieurs documents, j'ai pu utiliser le
RD
champ d'inclure ces mais -
J'ai une autre
Sub
qui génère personnalisé décimal numérotation des pages dans chaque document 0.0.0 (chapitre.de la section.page représentant) pour l'ensemble du document, à faire sens, doivent être inclus dans la table des matières des numéros de page. Il y a sans doute une autre façon de faire, mais je suis venu vide avec le Mot fonctionnalités intégrées.
Cela va devenir une Fonction pour être inclus dans ma page de numérotation Sub
. Je suis actuellement en train de 3/4 de la façon de remplir ce petit projet, le dernier trimestre devrait être simple.
Révisé et nettoyé le Code final
Public Sub CreateOutline()
' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document
Dim docOutline As Word.Document
Dim docSource As Word.Document
Dim rng As Word.Range
Dim strFootNum() As Integer
Dim astrHeadings As Variant
Dim strText As String
Dim intLevel As Integer
Dim intItem As Integer
Dim minLevel As Integer
Dim tabStops As Variant
Set docSource = ActiveDocument
Set docOutline = Documents.Add
minLevel = 5 'levels above this value won't be copied.
' Content returns only the
' main body of the document, not
' the headers and footer.
Set rng = docOutline.Content
astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)
docSource.Select
ReDim strFootNum(0 To UBound(astrHeadings))
For i = 1 To UBound(astrHeadings)
With Selection.Find
.Text = Trim(astrHeadings(i))
.Wrap = wdFindContinue
End With
If Selection.Find.Execute = True Then
strFootNum(i) = Selection.Information(wdActiveEndPageNumber)
Else
MsgBox "No selection found", vbOKOnly
End If
Selection.Move
Next
docOutline.Select
With Selection.Paragraphs.tabStops
'.Add Position:=InchesToPoints(2), Alignment:=wdAlignTabLeft
.Add Position:=InchesToPoints(6), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots
End With
For intItem = LBound(astrHeadings) To UBound(astrHeadings)
' Get the text and the level.
' strText = Trim$(astrHeadings(intItem))
intLevel = GetLevel(CStr(astrHeadings(intItem)))
' Test which heading is selected and indent accordingly
If intLevel <= minLevel Then
If intLevel = "1" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "2" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "3" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "4" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "5" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
' Add the text to the document.
rng.InsertAfter strText & vbLf
docOutline.SelectAllEditableRanges
' tab stop to set at 15.24 cm
'With Selection.Paragraphs.tabStops
' .Add Position:=InchesToPoints(6), _
' Leader:=wdTabLeaderDots, Alignment:=wdAlignTabRight
' .Add Position:=InchesToPoints(2), Alignment:=wdAlignTabCenter
'End With
rng.Collapse wdCollapseEnd
End If
Next intItem
End Sub
Private Function GetLevel(strItem As String) As Integer
' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document
' Return the heading level of a header from the
' array returned by Word.
' The number of leading spaces indicates the
' outline level (2 spaces per level: H1 has
' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.
Dim strTemp As String
Dim strOriginal As String
Dim intDiff As Integer
' Get rid of all trailing spaces.
strOriginal = RTrim$(strItem)
' Trim leading spaces, and then compare with
' the original.
strTemp = LTrim$(strOriginal)
' Subtract to find the number of
' leading spaces in the original string.
intDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (intDiff / 2) + 1
End Function
Ce code est en train de produire (Ce qu'il devrait être selon mes têtes de spécification trouvé dans test-doc.docx):
This is heading one 1.2.1
This is heading two 1.2.1
This is heading two.one 1.2.1
This is heading two.three 1.2.1
This is heading one.two 1.2.2
This is heading three 1.2.2
This is heading four 1.2.2
This is heading five 1.2.2
This is heading five.one 1.2.3
This is heading five.two 1.2.3
En Plus de cela, j'ai résolu le ActiveDocument
de commutation problème en utilisant docSource.select
et docOutline.Select
consolidés au lieu d'utiliser.Active
.
Encore merci Kevin, grandement appréciée 🙂
Phil
Alors qu'il est louable que vous avez posté votre code final à la question d'origine n'est plus apparent de poste de votre édition
OriginalL'auteur Phil Clayton | 2012-11-11
Vous devez vous connecter pour publier un commentaire.
Il ressemble
Selection.Information(wdActiveEndPageNumber)
permettra d'adapter le projet de loi, même s'il est dans le mauvais point de votre code. Mettre cette ligne après l'exécution de la trouver, comme suit:Plus de nouvelle question:
Lors de la configuration de la strFooter valeurs, vous êtes à l'aide de
ReDim
pour redimensionner le tableau lorsque vous devriez être en utilisantReDim Preserve
:Mais, à moins que
UBound(astrHeadings)
est en train de changer au cours de laFor
boucle en question, il serait probablement les meilleures pratiques pour tirer leReDim
énoncé à l'extérieur de la boucle:Pour référence, le
ReDim
instruction définit tous les éléments d'un tableau à 0, alors que laReDim Preserve
conserve toutes les données dans le tableau avant de le redimensionner.Note également de la
Selection.Move
et la.Wrap = wdFindContinue
lignes - je pense qu'il s'agissait de la racine de la question avec mes suggestions précédentes. La sélection devrait être fixé à la dernière page, parce que le trouver n'était pas d'emballage sur une course de cette autre que la première manche.C'est bien, le tout en bon temps! 🙂 Content d'avoir pu aider!
OriginalL'auteur Kevin Pope