Макрос разметки MS Word
Материал из PraxOS
SubWord2MediaWiki()
- Application.ScreenUpdating=False
- ReplaceQuotes
- MediaWikiEscapeChars
- MediaWikiConvertHyperlinks
- MediaWikiConvertH1
- MediaWikiConvertH2
- MediaWikiConvertH3
- MediaWikiConvertH4
- MediaWikiConvertH5
- MediaWikiConvertItalic
- MediaWikiConvertBold
- MediaWikiConvertUnderline
- MediaWikiConvertStrikeThrough
- MediaWikiConvertSuperscript
- MediaWikiConvertSubscript
- MediaWikiConvertLists
- MediaWikiConvertTables
- 'Copytoclipboard
- ActiveDocument.Content.Copy
- Application.ScreenUpdating=True
EndSub
PrivateSubMediaWikiConvertH1()
- ReplaceHeadingwdStyleHeading1,"="
EndSub
PrivateSubMediaWikiConvertH2()
- ReplaceHeadingwdStyleHeading2,"=="
EndSub
PrivateSubMediaWikiConvertH3()
- ReplaceHeadingwdStyleHeading3,"==="
EndSub
PrivateSubMediaWikiConvertH4()
- ReplaceHeadingwdStyleHeading4,"===="
EndSub
PrivateSubMediaWikiConvertH5()
- ReplaceHeadingwdStyleHeading5,"====="
EndSub
PrivateSubMediaWikiConvertBold()
- ActiveDocument.Select
- WithSelection.Find
- .ClearFormatting
- .Font.Bold=True
- .Text=""
- .Format=True
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- .Forward=True
- .Wrap=wdFindContinue
- DoWhile.Execute
- WithSelection
- IfLen(.Text)>1AndInStr(1,.Text,vbCr)Then
- 'Justprocessthechunkbeforeanynewlinecharacters
- 'We'llpick-uptherestwiththenextsearch
- .Collapse
- .MoveEndUntilvbCr
- EndIf
- 'Don'tbothertomarkupnewlinecharacters(preventsaloop,aswell)
- IfNot.Text=vbCrThen
- .InsertBefore""
- .InsertAfter""
- EndIf
- .Style=ActiveDocument.Styles("DefaultParagraphFont")
- .Font.Bold=False
- EndWith
- Loop
- EndWith
EndSub
PrivateSubMediaWikiConvertItalic()
- ActiveDocument.Select
- WithSelection.Find
- .ClearFormatting
- .Font.Italic=True
- .Text=""
- .Format=True
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- .Forward=True
- .Wrap=wdFindContinue
- DoWhile.Execute
- WithSelection
- IfLen(.Text)>1AndInStr(1,.Text,vbCr)Then
- 'Justprocessthechunkbeforeanynewlinecharacters
- 'We'llpick-uptherestwiththenextsearch
- .Collapse
- .MoveEndUntilvbCr
- EndIf
- 'Don'tbothertomarkupnewlinecharacters(preventsaloop,aswell)
- IfNot.Text=vbCrThen
- .InsertBefore""
- .InsertAfter""
- EndIf
- .Style=ActiveDocument.Styles("DefaultParagraphFont")
- .Font.Italic=False
- EndWith
- Loop
- EndWith
EndSub
PrivateSubMediaWikiConvertUnderline()
- ActiveDocument.Select
- WithSelection.Find
- .ClearFormatting
- .Font.Underline=True
- .Text=""
- .Format=True
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- .Forward=True
- .Wrap=wdFindContinue
- DoWhile.Execute
- WithSelection
- IfLen(.Text)>1AndInStr(1,.Text,vbCr)Then
- 'Justprocessthechunkbeforeanynewlinecharacters
- 'We'llpick-uptherestwiththenextsearch
- .Collapse
- .MoveEndUntilvbCr
- EndIf
- 'Don'tbothertomarkupnewlinecharacters(preventsaloop,aswell)
- IfNot.Text=vbCrThen
- .InsertBefore""
- .InsertAfter""
- EndIf
- .Style=ActiveDocument.Styles("DefaultParagraphFont")
- .Font.Underline=False
- EndWith
- Loop
- EndWith
EndSub
PrivateSubMediaWikiConvertStrikeThrough()
- ActiveDocument.Select
- WithSelection.Find
- .ClearFormatting
- .Font.StrikeThrough=True
- .Text=""
- .Format=True
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- .Forward=True
- .Wrap=wdFindContinue
- DoWhile.Execute
- WithSelection
- IfLen(.Text)>1AndInStr(1,.Text,vbCr)Then
- 'Justprocessthechunkbeforeanynewlinecharacters
- 'We'llpick-uptherestwiththenextsearch
- .Collapse
- .MoveEndUntilvbCr
- EndIf
- 'Don'tbothertomarkupnewlinecharacters(preventsaloop,aswell)
- IfNot.Text=vbCrThen
- .InsertBefore"-"
- .InsertAfter"-"
- EndIf
- .Style=ActiveDocument.Styles("DefaultParagraphFont")
- .Font.StrikeThrough=False
- EndWith
- Loop
- EndWith
EndSub
PrivateSubMediaWikiConvertSuperscript()
- ActiveDocument.Select
- WithSelection.Find
- .ClearFormatting
- .Font.Superscript=True
- .Text=""
- .Format=True
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- .Forward=True
- .Wrap=wdFindContinue
- DoWhile.Execute
- WithSelection
- .Text=Trim(.Text)
- IfLen(.Text)>1AndInStr(1,.Text,vbCr)Then
- 'Justprocessthechunkbeforeanynewlinecharacters
- 'We'llpick-uptherestwiththenextsearch
- .Collapse
- .MoveEndUntilvbCr
- EndIf
- 'Don'tbothertomarkupnewlinecharacters(preventsaloop,aswell)
- IfNot.Text=vbCrThen
- .InsertBefore"^"
- .InsertAfter"^"
- EndIf
- .Style=ActiveDocument.Styles("DefaultParagraphFont")
- .Font.Superscript=False
- EndWith
- Loop
- EndWith
EndSub
PrivateSubMediaWikiConvertSubscript()
- ActiveDocument.Select
- WithSelection.Find
- .ClearFormatting
- .Font.Subscript=True
- .Text=""
- .Format=True
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- .Forward=True
- .Wrap=wdFindContinue
- DoWhile.Execute
- WithSelection
- .Text=Trim(.Text)
- IfLen(.Text)>1AndInStr(1,.Text,vbCr)Then
- 'Justprocessthechunkbeforeanynewlinecharacters
- 'We'llpick-uptherestwiththenextsearch
- .Collapse
- .MoveEndUntilvbCr
- EndIf
- 'Don'tbothertomarkupnewlinecharacters(preventsaloop,aswell)
- IfNot.Text=vbCrThen
- .InsertBefore"~"
- .InsertAfter"~"
- EndIf
- .Style=ActiveDocument.Styles("DefaultParagraphFont")
- .Font.Subscript=False
- EndWith
- Loop
- EndWith
EndSub
PrivateSubMediaWikiConvertLists()
- DimparaAsParagraph
- ForEachparaInActiveDocument.ListParagraphs
- Withpara.Range
- .InsertBefore""
- Fori=1To.ListFormat.ListLevelNumber
- If.ListFormat.ListType=wdListBulletThen
- .InsertBefore"*"
- Else
- .InsertBefore"#"
- EndIf
- Nexti
- .ListFormat.RemoveNumbers
- EndWith
- Nextpara
EndSub
PrivateSubMediaWikiConvertTables()
- DimthisTableAsTable
- ForEachthisTableInActiveDocument.Tables
- WiththisTable
- ForEachaRowInthisTable.Rows
- WithaRow
- ForEachaCellInaRow.Cells
- WithaCell
- aCell.Range.InsertBefore"|"
- 'aCell.Range.InsertAfter"|"
- EndWith
- NextaCell
- '.Range.InsertBefore"|"
- .Range.InsertAftervbCrLf+"|-"
- EndWith
- NextaRow
- .Range.InsertBefore"{|"+vbCrLf
- .Range.InsertAftervbCrLf+"|}"
- .ConvertToText"|"
- EndWith
- NextthisTable
EndSub
PrivateSubMediaWikiConvertHyperlinks()
- DimhyperCountAsInteger
- hyperCount=ActiveDocument.Hyperlinks.Count
- Fori=1TohyperCount
- WithActiveDocument.Hyperlinks(1)
- DimaddrAsString
- addr=.Address
- .Delete
- .Range.InsertBefore"["
- .Range.InsertAfter"-"&addr&"]"
- EndWith
- Nexti
EndSub
'Replaceallsmartquoteswiththeirdumbequivalents
PrivateSubReplaceQuotes()
- DimquotesAsBoolean
- quotes=Options.AutoFormatAsYouTypeReplaceQuotes
- Options.AutoFormatAsYouTypeReplaceQuotes=False
- ReplaceStringChrW(8220),""""
- ReplaceStringChrW(8221),""""
- ReplaceString"‘","'"
- ReplaceString"’","'"
- Options.AutoFormatAsYouTypeReplaceQuotes=quotes
EndSub
PrivateSubMediaWikiEscapeChars()
- EscapeCharacter"*"
- EscapeCharacter"#"
- 'EscapeCharacter"_"
- 'EscapeCharacter"-"
- 'EscapeCharacter"+"
- EscapeCharacter"{"
- EscapeCharacter"}"
- EscapeCharacter"["
- EscapeCharacter"]"
- EscapeCharacter"~"
- EscapeCharacter"^^"
- EscapeCharacter"|"
- EscapeCharacter"'"
EndSub
PrivateFunctionReplaceHeading(styleHeadingAsString,headerPrefixAsString)
- DimnormalStyleAsStyle
- SetnormalStyle=ActiveDocument.Styles(wdStyleNormal)
- ActiveDocument.Select
- WithSelection.Find
- .ClearFormatting
- .Style=ActiveDocument.Styles(styleHeading)
- .Text=""
- .Format=True
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- .Forward=True
- .Wrap=wdFindContinue
- DoWhile.Execute
- WithSelection
- IfInStr(1,.Text,vbCr)Then
- 'Justprocessthechunkbeforeanynewlinecharacters
- 'We'llpick-uptherestwiththenextsearch
- .Collapse
- .MoveEndUntilvbCr
- EndIf
- 'Don'tbothertomarkupnewlinecharacters(preventsaloop,aswell)
- IfNot.Text=vbCrThen
- .InsertBeforeheaderPrefix
- .InsertBeforevbCr
- .InsertAfterheaderPrefix
- EndIf
- .Style=normalStyle
- EndWith
- Loop
- EndWith
EndFunction
PrivateFunctionEscapeCharacter(charAsString)
- ReplaceStringchar,"\"&char
EndFunction
PrivateFunctionReplaceString(findStrAsString,replacementStrAsString)
- Selection.Find.ClearFormatting
- Selection.Find.Replacement.ClearFormatting
- WithSelection.Find
- .Text=findStr
- .Replacement.Text=replacementStr
- .Forward=True
- .Wrap=wdFindContinue
- .Format=False
- .MatchCase=False
- .MatchWholeWord=False
- .MatchWildcards=False
- .MatchSoundsLike=False
- .MatchAllWordForms=False
- EndWith
- Selection.Find.ExecuteReplace:=wdReplaceAll
EndFunction
