Automatisere en manuell prosess med en Macro

Jason er en student redaktør av en akademisk lov journal. Som en del av publiseringsprosessen han trenger for å sjekke hver setning for plagiat og nøyaktighet og hver sitat for å sikre riktig formatering og støtte. Dette betyr i utgangspunktet hver setning må støttes av et sitat, plassert i en fotnote. I dag den ansatte manuelt kopierer og limer hver tekst setning, fotnote, og fotnote nummer fra forfatterens manuskript (et Word-dokument) i en stab redaktørens Word-dokument som deretter brukes for å sjekke. Jason lurer på om det er en måte å automatisere denne prosessen med å kopiere over "fotnote nummer", "setning fra artikkelen dokument" og "original fotnote innhold" fra manuskriptet kildedokumentet inn i regnearket dokumentet.

Hver av oppgavene nevnt av Jason kan gjøres programmatisk, med noen irriterende unntak. Det er ikke så vanskelig å gå gjennom fotnote og sluttnote samlinger, i VBA, og trekke ut informasjon fra dem. Denne informasjonen kan deretter bli flyttet til et nytt dokument som kan brukes som redaktørens arket. Den irriterende er at fotnote og EndNote tallene er dynamisk, og derfor ikke så lett å få tilgang. En full diskusjon om dette irriterende kan finnes på dette nettstedet:

http://www.vbaexpress.com/forum/showthread.php?31231

Nøyaktig hvordan du kan gå om å lage en makro for å gjøre informasjonsoverføring fra et dokument til et annet, avhenger i stor grad på egenskapene til infomraiton i forfatterens dokumentet. For eksempel, gjør forfatterens dokumentet omfatter ett eller to mellomrom etter en setning? Betyr det at flere fotnoter per setning? Betyr det at sluttnoter i tillegg til fotnoter? Omfatter det tabeller?

Poenget er at ther finnes en rekke hensyn som kan påvirke utviklingen av en makro. Dette betyr at eventuelle makroer må finjusteres til kilden dokumentet du arbeider med-som betyr masse testing. For å gi deg et utgangspunkt, men vurdere følgende makroer. De vil kopiere setninger, fotnoter og sluttnoter (hvis noen) fra et kildedokument til et nytt dokument.

Sub FootnotesEndnotes ()
Dim fNote Som Fotnote
Dim eNote Som Endnote
Dim Arange Som Range
Dim SSkrive As String
Dim rText As String
Dim Eref As String
Dim newDoc Som Document
Dim oldDoc Som Document

Satt oldDoc = ActiveDocument
Satt newDoc = Documents.Add

SSkrive = "--------------- FOTNOTER ---------------" & vbCr
newDoc.Content.InsertAfter SSkrive

oldDoc.Activate
For Hver fNote I ActiveDocument.Footnotes
Satt Arange = fNote.Reference
aRange.MoveStart enhet: = wdSentence, Count: = - 1
aRange.MoveEnd enhet: = wdSentence
SSkrive = aRange.Text
rText = fNote.Range.Text
Med fNote.Reference.Characters.First
.Collapse
.InsertCrossReference WdRefTypeFootnote, _
wdFootnoteNumberFormatted, fNote.Index
Eref = .Characters.First.Fields (1) .Result
Selection.Start = fNote.Reference.Start - Len (Eref)
Selection.End = fNote.Reference.Start
Selection.Delete
Avslutt med
Call WriteNewdoc (newDoc, SSkrive, rText, Eref, "Fotnote Text")
Neste fNote

SSkrive = "--------------- sluttnoter ----------------" & vbCr
newDoc.Content.InsertAfter vbCr & vbCr & SSkrive

For Hver eNote I ActiveDocument.Endnotes
Set Arange = eNote.Reference
aRange.MoveStart enhet: = wdSentence, Count: = - 1
aRange.MoveEnd enhet: = wdSentence
SSkrive = aRange.Text
rText = eNote.Range.Text
Med eNote.Reference.Characters.First
.Collapse
.InsertCrossReference WdRefTypeEndnote, _
wdEndnoteNumberFormatted, eNote.Index
Eref = .Characters.First.Fields (1) .Result
Selection.Start = eNote.Reference.Start - Len (Eref)
Selection.End = eNote.Reference.Start
Selection.Delete
Avslutt med
Call WriteNewdoc (newDoc, SSkrive, rText, Eref, "Endnote Text")
Neste eNote

newDoc.Activate
End Sub

Sub WriteNewdoc (newDoc Som dokument, SSkrive As String, rText As String, _
Eref As String, Astyle As String)
Dim sText1 As String
Dim sText2 As String
Dim Drange Som Range
Dim k Som Long
Dim curDoc Som Document

Satt curDoc = ActiveDocument
newDoc.Activate
k = InStr (SSkrive, Chr (2))
Hvis k = 1 Så SSkrive = Mid (SSkrive, 2) "i tilfelle forrige setning har note
SSkrive = Trim (SSkrive)
k = InStr (SSkrive, Chr (2))
Dersom k = 0 Deretter
SSkrive = SSkrive & Chr (2)
k = Len (SSkrive)
End If
Hvis k> 1 Deretter
sText1 = Left (SSkrive, k - 1)
Else
sText1 = ""
End If
Hvis k = Len (SSkrive) Deretter
sText2 = ""
Else
sText2 = Mid (SSkrive, k + 1)
End If
Hvis Len (sText2)> 0 Then
Hvis Mid (sText2, Len (sText2), 1) = Chr (13) Deretter
sText2 = Left (sText2, Len (sText2) - 1)
End If
End If
Satt Drange = newDoc.Content
dRange.Collapse Regi: = wdCollapseEnd
dRange.Select
Med markering
.InsertAfter VbCr & sText1
.Font.Superscript = False
.Collapse Direction: = wdCollapseEnd
.InsertAfter Eref
.Font.Superscript = True
.Collapse Direction: = wdCollapseEnd
.InsertAfter "" & SText2 & vbCr
.Font.Superscript = False
.Collapse Direction: = wdCollapseEnd
.InsertAfter Eref
.Font.Superscript = True
.Collapse Direction: = wdCollapseEnd
.InsertAfter "" & RText & vbCr & vbCr
.Font.Superscript = False
.Style = Astyle
Avslutt med
curDoc.Activate
End Sub

Dette er (igjen) bare et startpunkt. Du må teste og finjustere makroer med dokumentene for å sørge for at de gjør hva du forventer.

Hvis du er ute etter tilleggsressurser til hjelp i å utvikle en slik makro, kan du prøve denne boken. Det er en freebie, og det kan ha noen makroer (eller eksempler) som du kan tilpasse til dine spesifikke formål:

http://www.archivepub.co.uk/book.html

Ikke bli overrasket hvis din makro blir ganske komplisert over tid. Dette er å forvente når du oppretter en makro til å utføre oppgaver som mennesker kan gjøre med relativt lite tenkning.

WordTips er din kilde for kostnadseffektiv Microsoft Word trening. (Microsoft Word er den mest populære tekstbehandlingsprogrammet i verden.) Dette tipset (12724) gjelder for Microsoft Word 2007, 2010, og 2013.