Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub Word2Textile()
- Application.ScreenUpdating = False
- ConvertH1
- ConvertH2
- ConvertH3
- ConvertH4
- ConvertH5
- ConvertItalic
- ConvertBold
- ConvertUnderline
- ConvertLists
- ConvertTables
- ReplaceQuotes
- ' Copy to clipboard
- ActiveDocument.Content.Copy
- Application.ScreenUpdating = True
- End Sub
- Private Sub ConvertH1()
- Dim normalStyle As Style
- Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
- ActiveDocument.Select
- With Selection.Find
- .ClearFormatting
- .Style = ActiveDocument.Styles(wdStyleHeading1)
- .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 "h3. "
- End If
- .Style = normalStyle
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertH2()
- Dim normalStyle As Style
- Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
- ActiveDocument.Select
- With Selection.Find
- .ClearFormatting
- .Style = ActiveDocument.Styles(wdStyleHeading2)
- .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 "h3. "
- End If
- .Style = normalStyle
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertH3()
- Dim normalStyle As Style
- Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
- ActiveDocument.Select
- With Selection.Find
- .ClearFormatting
- .Style = ActiveDocument.Styles(wdStyleHeading3)
- .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 "h3. "
- End If
- .Style = normalStyle
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertH4()
- Dim normalStyle As Style
- Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
- ActiveDocument.Select
- With Selection.Find
- .ClearFormatting
- .Style = ActiveDocument.Styles(wdStyleHeading4)
- .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 "h4. "
- End If
- .Style = normalStyle
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertH5()
- Dim normalStyle As Style
- Set normalStyle = ActiveDocument.Styles(wdStyleNormal)
- ActiveDocument.Select
- With Selection.Find
- .ClearFormatting
- .Style = ActiveDocument.Styles(wdStyleHeading4)
- .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 "h5. "
- End If
- .Style = normalStyle
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertBold()
- 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 InStr(1, .Text, vbCr) Then
- ' Just process the chunk before any newline characters
- ' We'll pick-up the rest with the next search
- .Font.Bold = False
- .Collapse
- .MoveEndUntil vbCr
- End If
- ' Don't bother to markup newline characters (prevents a loop, as well)
- If Not .Text = vbCr Then
- .InsertBefore "<b>"
- .InsertAfter "</b>"
- End If
- .Font.Bold = False
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertItalic()
- 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 InStr(1, .Text, vbCr) Then
- ' Just process the chunk before any newline characters
- ' We'll pick-up the rest with the next search
- .Font.Italic = False
- .Collapse
- .MoveEndUntil vbCr
- End If
- ' Don't bother to markup newline characters (prevents a loop, as well)
- If Not .Text = vbCr Then
- .InsertBefore "<i>"
- .InsertAfter "</i>"
- End If
- .Font.Italic = False
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertUnderline()
- 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 InStr(1, .Text, vbCr) Then
- ' Just process the chunk before any newline characters
- ' We'll pick-up the rest with the next search
- .Font.Underline = False
- .Collapse
- .MoveEndUntil vbCr
- End If
- ' Don't bother to markup newline characters (prevents a loop, as well)
- If Not .Text = vbCr Then
- .InsertBefore "<u>"
- .InsertAfter "</u>"
- End If
- .Font.Underline = False
- End With
- Loop
- End With
- End Sub
- Private Sub ConvertLists()
- Dim para As Paragraph
- For Each para In ActiveDocument.ListParagraphs
- With para.Range
- .InsertBefore " "
- For i = 1 To .ListFormat.ListLevelNumber
- If .ListFormat.ListType = wdListBullet Then
- .InsertBefore "*"
- Else
- .InsertBefore "#"
- End If
- Next i
- .ListFormat.RemoveNumbers
- End With
- Next para
- End Sub
- Private Sub ConvertTables()
- Dim oTable As Table
- For Each oTable In ActiveDocument.Tables
- With oTable
- ReDim x(1 To oTable.Rows.Count, 1 To oTable.Columns.Count)
- i = 0
- For Each a In oTable.Rows
- i = i + 1
- j = 0
- For Each b In a.Cells
- j = j + 1
- strText = b.Range.Text
- x(i, j) = Left(strText, Len(strText) - 2)
- Next b
- Next a
- .Range.InsertParagraphAfter
- .Range.InsertAfter ("{| border=1")
- .Range.InsertParagraphAfter
- For k = 1 To i
- For l = 1 To j
- .Range.InsertAfter " || " + x(k, l)
- '.Range.InsertParagraphAfter
- Next
- .Range.InsertParagraphAfter
- .Range.InsertAfter "|-"
- .Range.InsertParagraphAfter
- Next
- .Range.InsertAfter ("|}")
- .Range.InsertParagraphAfter
- End With
- Next oTable
- 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 "’", "'"
- ReplaceString "", "'"
- ReplaceString "^p", "^p^p"
- ReplaceString "^p^p^p", "^p^p"
- Options.AutoFormatAsYouTypeReplaceQuotes = quotes
- End Sub
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement