Differences

This shows you the differences between two versions of the page.

Link to this comparison view

Next revision
Previous revision
Next revisionBoth sides next revision
internal_link2 [2009/08/03 08:48] – created clareinternal_link2 [2009/08/03 08:50] – removed clare
Line 1: Line 1:
-Attribute VB_Name = "Word2DokuWikiv3" Sub Word2DokuWiki() Application.ScreenUpdating = False ReplaceQuotes DokuWikiEscapeChars DokuWikiConvertHyperlinks DokuWikiConvertH1 DokuWikiConvertH2 DokuWikiConvertH3 DokuWikiConvertH4 DokuWikiConvertH5 DokuWikiConvertItalic DokuWikiConvertBold DokuWikiConvertUnderline DokuWikiConvertStrikeThrough DokuWikiConvertSuperscript DokuWikiConvertSubscript DokuWikiConvertLists DokuWikiConvertTable UndoDokuWikiEscapeChars ' Copy to clipboard ActiveDocument.Content.Copy Application.ScreenUpdating = True End Sub Private Sub DokuWikiConvertH1() ReplaceHeading wdStyleHeading1, "======" End Sub Private Sub DokuWikiConvertH2() ReplaceHeading wdStyleHeading2, "=====" End Sub Private Sub DokuWikiConvertH3() ReplaceHeading wdStyleHeading3, "====" End Sub Private Sub DokuWikiConvertH4() ReplaceHeading wdStyleHeading4, "===" End Sub Private Sub DokuWikiConvertH5() ReplaceHeading wdStyleHeading5, "==" End Sub Private Sub DokuWikiConvertH6() ReplaceHeading wdStyleHeading5, "=" End Sub Private Sub DokuWikiConvertBold() ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Bold = True .Text = "" .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Forward = True .Wrap = wdFindContinue Do While .Execute With Selection If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then ' Just process the chunk before any newline characters ' We'll pick-up the rest with the next search .Collapse .MoveEndUntil vbCr End If ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then If Not Left(.Text, 2) = "%%**%%" Then .InsertBefore "%%**%%" End If If Not Right(.Text, 2) = "%%**%%" Then .InsertAfter "%%**%%" End If End If .Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Bold = False End With Loop End With End Sub Private Sub DokuWikiConvertItalic() ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Italic = True .Text = "" .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Forward = True .Wrap = wdFindContinue Do While .Execute With Selection If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then ' Just process the chunk before any newline characters ' We'll pick-up the rest with the next search .Collapse .MoveEndUntil vbCr End If ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then If Not Left(.Text, 2) = "%%//%%" Then .InsertBefore "%%//%%" End If If Not Right(.Text, 2) = "%%//%%" Then .InsertAfter "%%//%%" End If End If .Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Italic = False End With Loop End With End Sub Private Sub DokuWikiConvertUnderline() ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Underline = True .Text = "" .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Forward = True .Wrap = wdFindContinue Do While .Execute With Selection If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then ' Just process the chunk before any newline characters ' We'll pick-up the rest with the next search .Collapse .MoveEndUntil vbCr End If ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then If Not Left(.Text, 2) = "%%__%%" Then .InsertBefore "%%__%%" End If If Not Right(.Text, 2) = "%%__%%" Then .InsertAfter "%%__%%" End If End If .Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Underline = False End With Loop End With End Sub Private Sub DokuWikiConvertStrikeThrough() ActiveDocument.Select With Selection.Find .ClearFormatting .Font.StrikeThrough = True .Text = "" .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Forward = True .Wrap = wdFindContinue Do While .Execute With Selection If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then ' Just process the chunk before any newline characters ' We'll pick-up the rest with the next search .Collapse .MoveEndUntil vbCr End If ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then If Not Left(.Text, 2) = "<del>" Then .InsertBefore "</del>" End If If Not Right(.Text, 2) = " 
  
-" Then .InsertAfter " 
- 
-" End If End If .Style = ActiveDocument.Styles("Default Paragraph Font") .Font.StrikeThrough = False End With Loop End With End Sub Private Sub DokuWikiConvertSuperscript() ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Superscript = True .Text = "" .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Forward = True .Wrap = wdFindContinue Do While .Execute With Selection .Text = Trim(.Text) If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then ' Just process the chunk before any newline characters ' We'll pick-up the rest with the next search .Collapse .MoveEndUntil vbCr End If ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then If Not Left(.Text, 2) = "<sup>" Then .InsertBefore "<sup>" End If If Not Right(.Text, 2) = "</sup>" Then .InsertAfter "</sup>" End If End If .Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Superscript = False End With Loop End With End Sub Private Sub DokuWikiConvertSubscript() ActiveDocument.Select With Selection.Find .ClearFormatting .Font.Subscript = True .Text = "" .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Forward = True .Wrap = wdFindContinue Do While .Execute With Selection .Text = Trim(.Text) If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then ' Just process the chunk before any newline characters ' We'll pick-up the rest with the next search .Collapse .MoveEndUntil vbCr End If ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then If Not Left(.Text, 2) = "<sub>" Then .InsertBefore "<sub>" End If If Not Right(.Text, 2) = "</sub>" Then .InsertAfter "</sub>" End If End If .Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Subscript = False End With Loop End With End Sub Private Sub DokuWikiConvertLists() Dim para As Paragraph For Each para In ActiveDocument.ListParagraphs With para.Range .InsertBefore " " If .ListFormat.ListType = wdListBullet Then .InsertBefore "*" Else .InsertBefore "-" End If For i = 1 To .ListFormat.ListLevelNumber .InsertBefore " " Next i .ListFormat.RemoveNumbers End With Next para End Sub Private Sub DokuWikiConvertHyperlinks() Dim hyperCount As Integer hyperCount = ActiveDocument.Hyperlinks.Count For i = 1 To hyperCount With ActiveDocument.Hyperlinks(1) Dim addr As String addr = .Address .Delete .Range.InsertBefore "[" .Range.InsertAfter "-" & addr & "]" End With Next i End Sub ' Replace all smart quotes with their dumb equivalents Private Sub ReplaceQuotes() Dim quotes As Boolean quotes = Options.AutoFormatAsYouTypeReplaceQuotes Options.AutoFormatAsYouTypeReplaceQuotes = False ReplaceString ChrW(8220), """" ReplaceString ChrW(8221), """" ReplaceString "ë", "'" ReplaceString "í", "'" Options.AutoFormatAsYouTypeReplaceQuotes = quotes End Sub Private Sub DokuWikiEscapeChars() EscapeCharacter "*" EscapeCharacter "#" EscapeCharacter "_" EscapeCharacter "-" EscapeCharacter "+" EscapeCharacter "{" EscapeCharacter "}" EscapeCharacter "[" EscapeCharacter "]" EscapeCharacter "~" EscapeCharacter "^^" EscapeCharacter "|" EscapeCharacter "'" End Sub Private Function ReplaceHeading(styleHeading As String, headerPrefix As String) Dim normalStyle As Style Set normalStyle = ActiveDocument.Styles(wdStyleNormal) ActiveDocument.Select With Selection.Find .ClearFormatting .Style = ActiveDocument.Styles(styleHeading) .Text = "" .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Forward = True .Wrap = wdFindContinue Do While .Execute With Selection If InStr(1, .Text, vbCr) Then ' Just process the chunk before any newline characters ' We'll pick-up the rest with the next search .Collapse .MoveEndUntil vbCr End If ' Don't bother to markup newline characters (prevents a loop, as well) If Not .Text = vbCr Then .InsertBefore headerPrefix .InsertBefore vbCr .InsertAfter headerPrefix End If .Style = normalStyle End With Loop End With End Function Private Sub DokuWikiConvertTable() Dim TotTables As Long Do While ActiveDocument.Tables.Count() > 0 ActiveDocument.Tables(1).Range.Select Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " $s$|$s$ " .Replacement.Text = "I" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " $s$^^$s$ " .Replacement.Text = "/\" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Application.DefaultTableSeparator = "|" Selection.Rows.ConvertToText Separator:=wdSeparateByDefaultListSeparator, NestedTables:=True Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^p" .Replacement.Text = "|^p|" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.InsertBefore ("|") Selection.InsertParagraphAfter Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^p|^p" .Replacement.Text = "^p" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "$s$blank$s$" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "||" .Replacement.Text = "| |" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "||" .Replacement.Text = "| |" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "| |" .Replacement.Text = "| |" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "| |" .Replacement.Text = "| |" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Paragraphs(1).Range.Select Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "|" .Replacement.Text = "^^" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Loop End Sub Private Sub UndoDokuWikiEscapeChars() UndoEscapeCharacter "*" UndoEscapeCharacter "#" UndoEscapeCharacter "_" UndoEscapeCharacter "-" UndoEscapeCharacter "+" UndoEscapeCharacter "{" UndoEscapeCharacter "}" UndoEscapeCharacter "[" UndoEscapeCharacter "]" UndoEscapeCharacter "~" UndoEscapeCharacter "^^" UndoEscapeCharacter "|" UndoEscapeCharacter "'" End Sub Private Function EscapeCharacter(char As String) ReplaceString char, " $s$" & char & "$s$ " End Function Private Function UndoEscapeCharacter(char As String) ReplaceString " $s$" & char & "$s$ ", char End Function Private Function ReplaceString(findStr As String, replacementStr As String) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = findStr .Replacement.Text = replacementStr .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll End Function 

Personal Tools