Welcome to Inkbunny...
Allowed ratings
To view member-only content, create an account. ( Hide )
Furry Genesis Evangelion by AppendageChild
« older
Neosate
Neosate's Gallery (321)

Word to InkBunny BBcode converter

word2ib.txt
Keywords bbcode 3, converter 3, visual basic 1, msword 1, word macro 1, word 2 inkbunny 1
'Sub word2bb()
'
' word2bb Macro
'
'
'Word2BBCode-Converter v0.1, June 2, 2019
'Some parts adapted from
'Word2Wiki-Converter V0.4, May 28, 2006
'http://de.wikipedia.org/wiki/Wikipedia:Helferlein/Word...
'Original Version by InfPro: http://www.infpro.com/downloads/downloads/wordmedia.htm
'Major improvements by Gunter Schmidt, Mail me: Word2MediaWikiPlus@beadsoft.de
'Works only with Word 2000 and above
'License: GPL: Feel free to use and modify. Keep the credits and do not sell.

Sub Word2BBCode()
    
    Application.ScreenUpdating = False
    
    ConvertTitle
    ConvertItalic
    ConvertBold
    ConvertUnderline
    ConvertSize
    ConvertLists
    ConvertHyperlinks
    CovertCenter
    ConvertNote
    AddCarriageReturns

  
    ActiveDocument.Content.Copy
    
    Application.ScreenUpdating = True
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 ConvertSize()
  
Dim fSize&
  
    If convertFontSize = False Then Exit Sub
  
    If DefaultFontSize = 12 Then DefaultFontSize = 12
    fSize = 12
      
    For fSize = 1 To 50
    If fSize > DefaultFontSize + 1 Or fSize < DefaultFontSize - 1 Then 'at least two points difference
        ActiveDocument.Select
        With Selection.Find
    
            .ClearFormatting
            .Font.Size = fSize
            .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 fSize = DefaultFontSize Then
                            .InsertBefore "[size=" & fSize & "]"
                            .InsertAfter "[/size]"
                         End If
                    End If
    
                    If useDefaultStyle Then .Style = ActiveDocument.Styles(DefaultStyleName) 'must be localized to your language, see CONST on top
                    .Font.Size = DefaultFontSize
                    '.Collapse wdCollapseEnd
                    '.MoveLeft , 4, True
                    'ClearFormatting
    
                End With
            Loop
        End With
    End If
    Next

End Sub
Private Sub ConvertLists()
   Dim para As Paragraph
    For Each para In ActiveDocument.ListParagraphs
        With para.Range
            .InsertBefore "[List]"
            For i = 1 To .ListFormat.ListLevelNumber
                If .ListFormat.ListType = wdListBullet Then
                    .InsertBefore "[*]"
                Else
                    .InsertBefore "[#]"
                End If
            Next i
            .InsertBefore "[List]"
            .ListFormat.RemoveNumbers
            
        End With
    Next para
End Sub
Private Sub ConvertHyperlinks()
    'converts Hyperlinks
    '24-MAY-2006: only convert http..., mark others with error marker

    Dim hyperCount&
    Dim i&
    Dim addr$ ', title$

    hyperCount = ActiveDocument.Hyperlinks.Count

    For i = 1 To hyperCount

        With ActiveDocument.Hyperlinks(1) 'must be 1, since the delete changes count and position

            addr = .Address
            If Trim$(addr) = "" Then addr = "no hyperlink found"
            'title = .Range.Text
          
            'http, ftp
            If LCase(Left$(addr, 4)) = "http" Or LCase(Left$(addr, 3)) = "ftp" Then
                .Delete 'hyperlink
                .Range.InsertBefore "[url=" & addr & "]"
                .Range.InsertAfter "[/url]"
              
                GoTo ConvertHyperlinks_Next
            End If
          
            'mailto:
            If LCase(Left$(addr, 7)) = "mailto:" Then
                .Delete 'hyperlink
                .Range.InsertBefore "[email]" & addr & " "
                .Range.InsertAfter "[/email]"
              
                GoTo ConvertHyperlinks_Next
            End If
          
            'file guess
            If Len(addr) > 4 Then 'the reason for not nice goto
                If Mid$(addr, Len(addr) - 3, 1) = "." Then
                    .Delete
                    .Range.InsertBefore "[file://" & Replace(addr, " ", "_") & " "
                    .Range.InsertAfter "]"
                  
                    GoTo ConvertHyperlinks_Next
                End If
            End If
          
            'unidentified
            .Delete
            .Range.InsertBefore UnableToConvertMarker & "[" & addr & " "
            .Range.InsertAfter "]"

ConvertHyperlinks_Next:
        End With

    Next i

End Sub

Private Sub CovertCenter()
    Dim Par As Paragraph, Rng As Range
    For Each Par In ActiveDocument.Paragraphs
        If Par.Alignment = wdAlignParagraphCenter Then
            If Rng Is Nothing Then
                Set Rng = Par.Range
            Else
                Rng.End = Par.Range.End
            End If
        Else
            Call CenterFmt(Rng)
        End If
        If Par.Range.End = ActiveDocument.Range.End Then
            Call CenterFmt(Rng)
        End If
    Next
End Sub

Private Sub CenterFmt(Rng As Range)
If Not Rng Is Nothing Then
  With Rng
    .End = .End - 1
    .InsertBefore "[center]"
    .InsertAfter "[/center]"
  End With
  Set Rng = Nothing
End If
End Sub

Private Sub ConvertTitle()
Application.ScreenUpdating = False
Dim Par As Paragraph, Rng As Range
For Each Par In ActiveDocument.Paragraphs
  If Par.Style = "Title" Then
    If Rng Is Nothing Then
      Set Rng = Par.Range
    Else
      Rng.End = Par.Range.End
    End If
  Else
    Call TitleFmt(Rng)
  End If
  If Par.Range.End = ActiveDocument.Range.End Then
    Call TitleFmt(Rng)
  End If
Next
Application.ScreenUpdating = True
End Sub

Private Sub TitleFmt(Rng As Range)
If Not Rng Is Nothing Then
  With Rng
    .End = .End - 1
    .InsertBefore "[t]"
    .InsertAfter "[/t]"
  End With
  Set Rng = Nothing
End If
End Sub

Private Sub AddCarriageReturns()
    Dim doc As Document
    Dim para As Paragraph

    Set doc = ActiveDocument

    For Each para In doc.Paragraphs
        If para.Style = doc.Styles(wdStyleNormal) Then
            para.Range.InsertBefore vbCr
        End If
    Next para
End Sub

Private Sub ConvertNote()

    Dim Par As Paragraph, Rng As Range
    For Each Par In ActiveDocument.Paragraphs
        If Par.Style = "Heading 5" Then
            If Rng Is Nothing Then
                Set Rng = Par.Range
            Else
                Rng.End = Par.Range.End
            End If
        Else
            Call NoteFmt(Rng)
        End If
            If Par.Range.End = ActiveDocument.Range.End Then
            Call NoteFmt(Rng)
        End If
    Next
End Sub

Private Sub NoteFmt(Rng As Range)
If Not Rng Is Nothing Then
  With Rng
    .End = .End - 1
    .InsertBefore "[color=#ff0000]"
    .InsertAfter "[/colot]"
  End With
  Set Rng = Nothing
End If
End Sub
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
page
1
page
2
page
3
page
4
page
5
page
6
page
7
page
8
page
9
page
10
page
11
page
12
page
13
page
14
page
15
page
16
page
17
page
18
page
19
page
20
page
21
page
22
page
23
page
24
page
25
page
26
page
27
page
28
page
29
page
30
page
31
page
32
page
33
page
34
page
35
page
36
page
37
page
38
page
39
page
40
page
41
page
42
page
43
page
44
page
45
page
46
page
47
page
48
page
49
page
50
page
51
page
52
page
53
page
54
page
55
page
56
page
57
page
58
page
59
page
60
page
61
page
62
page
63
page
64
page
65
page
66
page
67
page
68
page
69
page
70
page
71
page
72
page
73
page
74
page
75
page
76
page
77
page
78
page
79
page
80
page
81
page
82
page
83
page
84
page
85
page
86
page
87
page
88
page
89
page
90
page
91
page
92
page
93
page
94
page
95
page
96
page
97
page
98
page
99
page
100
page
101
page
102
page
103
page
104
page
105
page
106
page
107
page
108
page
109
page
110
page
111
page
112
page
113
page
114
page
115
page
116
page
117
page
118
page
119
page
120
page
121
page
122
page
123
page
124
page
125
page
126
page
127
page
128
page
129
page
130
page
131
page
132
page
133
page
134
page
135
page
136
page
137
page
138
page
139
page
140
page
141
page
142
page
143
page
144
page
145
page
146
page
147
page
148
page
149
page
150
page
151
page
152
page
153
page
154
page
155
page
156
page
157
page
158
page
159
page
160
page
161
page
162
page
163
page
164
page
165
page
166
page
167
page
168
page
169
page
170
page
171
page
172
page
173
page
174
page
175
page
176
page
177
page
178
page
179
page
180
page
181
page
182
page
183
page
184
page
185
page
186
page
187
page
188
page
189
page
190
page
191
page
192
page
193
page
194
page
195
page
196
page
197
page
198
page
199
page
200
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
next
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
previous
page
 
 
page
1
page
2
page
3
page
4
page
5
page
6
page
7
page
8
page
9
page
10
page
11
page
12
page
13
page
14
page
15
page
16
page
17
page
18
page
19
page
20
page
21
page
22
page
23
page
24
page
25
page
26
page
27
page
28
page
29
page
30
page
31
page
32
page
33
page
34
page
35
page
36
page
37
page
38
page
39
page
40
page
41
page
42
page
43
page
44
page
45
page
46
page
47
page
48
page
49
page
50
page
51
page
52
page
53
page
54
page
55
page
56
page
57
page
58
page
59
page
60
page
61
page
62
page
63
page
64
page
65
page
66
page
67
page
68
page
69
page
70
page
71
page
72
page
73
page
74
page
75
page
76
page
77
page
78
page
79
page
80
page
81
page
82
page
83
page
84
page
85
page
86
page
87
page
88
page
89
page
90
page
91
page
92
page
93
page
94
page
95
page
96
page
97
page
98
page
99
page
100
page
101
page
102
page
103
page
104
page
105
page
106
page
107
page
108
page
109
page
110
page
111
page
112
page
113
page
114
page
115
page
116
page
117
page
118
page
119
page
120
page
121
page
122
page
123
page
124
page
125
page
126
page
127
page
128
page
129
page
130
page
131
page
132
page
133
page
134
page
135
page
136
page
137
page
138
page
139
page
140
page
141
page
142
page
143
page
144
page
145
page
146
page
147
page
148
page
149
page
150
page
151
page
152
page
153
page
154
page
155
page
156
page
157
page
158
page
159
page
160
page
161
page
162
page
163
page
164
page
165
page
166
page
167
page
168
page
169
page
170
page
171
page
172
page
173
page
174
page
175
page
176
page
177
page
178
page
179
page
180
page
181
page
182
page
183
page
184
page
185
page
186
page
187
page
188
page
189
page
190
page
191
page
192
page
193
page
194
page
195
page
196
page
197
page
198
page
199
page
200
by Neosate
First in pool
Last in pool
This is a VBA script that I modified to convert much of the Word Document formatting into BBcode comparable with Inkbunny.

In order to use this script you need Microsoft Word installed on your computer. office 365 online does not work as far as I know.

1. open the document you want to convert.
2. go to "View"
3. click the "Macros" drop down and select "View Macros"
4. give the macro a name (i.e. word2ib).
5. copy the text from the script into the new macro code.
6 click the "Run" button. everything should work.
7. copy and past converted text into description, story text or Journal post.

Let me know if you have any issues for would like some custom work done to the script.

Support my work

Buy Merch
Reoccurring Donations
Patreon
Paypal Donations
SubscribStar

Keywords
Details
Type: Writing - Document
Published: 2 weeks, 1 day ago
Rating: General

MD5 Hash for Page 1... Show Find Identical Posts [?]
Stats
48 views
0 favorites
0 comments

BBCode Tags Show [?]
 
New Comment:
Move reply box to top
Log in or create an account to comment.