{
"submission_id": "2025431",
"keywords": [
{
"keyword_id": "11760",
"keyword_name": "bbcode",
"contributed": "f",
"submissions_count": "9"
},
{
"keyword_id": "425903",
"keyword_name": "converter",
"contributed": "f",
"submissions_count": "4"
},
{
"keyword_id": "504740",
"keyword_name": "msword",
"contributed": "f",
"submissions_count": "1"
},
{
"keyword_id": "504739",
"keyword_name": "visual basic",
"contributed": "f",
"submissions_count": "1"
},
{
"keyword_id": "504742",
"keyword_name": "word 2 inkbunny",
"contributed": "f",
"submissions_count": "1"
},
{
"keyword_id": "504741",
"keyword_name": "word macro",
"contributed": "f",
"submissions_count": "1"
}
],
"hidden": "f",
"scraps": "f",
"favorite": "f",
"favorites_count": "0",
"create_datetime": "2019-11-22 17:49:35.301486+00",
"create_datetime_usertime": "22 Nov 2019 18:49 CET",
"last_file_update_datetime": "2019-11-22 17:32:41.581312+00",
"last_file_update_datetime_usertime": "22 Nov 2019 18:32 CET",
"username": "Neosate",
"user_id": "180326",
"user_icon_file_name": "382981_Neosate_verb_winter_2_500px.png",
"user_icon_url_large": "https://nl1.ib.metapix.net/usericons/large/382/382981_Neosate_verb_winter_2_500px.png",
"user_icon_url_medium": "https://nl1.ib.metapix.net/usericons/medium/382/382981_Neosate_verb_winter_2_500px.png",
"user_icon_url_small": "https://nl1.ib.metapix.net/usericons/small/382/382981_Neosate_verb_winter_2_500px.png",
"file_name": "2925516_Neosate_word2ib.txt",
"file_url_full": "https://nl1.ib.metapix.net/files/full/2925/2925516_Neosate_word2ib.txt",
"file_url_screen": "https://nl1.ib.metapix.net/files/screen/2925/2925516_Neosate_word2ib.txt",
"file_url_preview": "https://nl1.ib.metapix.net/files/preview/2925/2925516_Neosate_word2ib.txt",
"thumbnail_url_huge": "https://nl1.ib.metapix.net/thumbnails/huge/2925/2925516_Neosate_word2ib.jpg",
"thumbnail_url_large": "https://nl1.ib.metapix.net/thumbnails/large/2925/2925516_Neosate_word2ib.jpg",
"thumbnail_url_medium": "https://nl1.ib.metapix.net/thumbnails/medium/2925/2925516_Neosate_word2ib.jpg",
"thumb_huge_x": "64",
"thumb_huge_y": "64",
"thumb_large_x": "64",
"thumb_large_y": "64",
"thumb_medium_x": "64",
"thumb_medium_y": "64",
"files": [
{
"file_id": "2925516",
"file_name": "2925516_Neosate_word2ib.txt",
"file_url_full": "https://nl1.ib.metapix.net/files/full/2925/2925516_Neosate_word2ib.txt",
"file_url_screen": "https://nl1.ib.metapix.net/files/screen/2925/2925516_Neosate_word2ib.txt",
"file_url_preview": "https://nl1.ib.metapix.net/files/preview/2925/2925516_Neosate_word2ib.txt",
"mimetype": "text/plain",
"submission_id": "2025431",
"user_id": "180326",
"submission_file_order": "0",
"full_size_x": null,
"full_size_y": null,
"screen_size_x": null,
"screen_size_y": null,
"preview_size_x": null,
"preview_size_y": null,
"initial_file_md5": "97338e6cbc4ba7d477d8d152bfeb814f",
"full_file_md5": "97338e6cbc4ba7d477d8d152bfeb814f",
"large_file_md5": "",
"small_file_md5": "",
"thumbnail_md5": "dee2dd3fd048129ee8caa821747407c6",
"deleted": "f",
"create_datetime": "2019-11-22 17:32:41.581312+00",
"create_datetime_usertime": "22 Nov 2019 18:32 CET",
"thumbnail_url_huge": "https://nl1.ib.metapix.net/thumbnails/huge/2925/2925516_Neosate_word2ib.jpg",
"thumbnail_url_large": "https://nl1.ib.metapix.net/thumbnails/large/2925/2925516_Neosate_word2ib.jpg",
"thumbnail_url_medium": "https://nl1.ib.metapix.net/thumbnails/medium/2925/2925516_Neosate_word2ib.jpg",
"thumb_huge_x": "64",
"thumb_huge_y": "64",
"thumb_large_x": "64",
"thumb_large_y": "64",
"thumb_medium_x": "64",
"thumb_medium_y": "64"
}
],
"pools": [
{
"pool_id": "61757",
"name": "Code Snipets",
"description": "Some free code snippets that I create or modify.",
"count": "1"
}
],
"description": "This is a VBA script that I modified to convert much of the Word Document formatting into BBcode comparable with Inkbunny. \n\nIn order to use this script you need Microsoft Word installed on your computer. office 365 online does not work as far as I know.\n\n1. open the document you want to convert.\n2. go to \"View\"\n3. click the \"Macros\" drop down and select \"View Macros\"\n4. give the macro a name (i.e. word2ib).\n5. copy the text from the script into the new macro code.\n6 click the \"Run\" button. everything should work.\n7. copy and past converted text into description, story text or Journal post.\n\nLet me know if you have any issues for would like some custom work done to the script.\n\n[t]Support my work[/t]\n\n[url=https://www.taomerle.com/][b]Buy Merch[/b] [/url]\n[url=https://liberapay.com/neosate/donate][b]Reoccurring Donations[/b][/url]\n[url=https://www.patreon.com/neosate][b]Patreon [/b][/url]\n[url=https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=TBN7PFR47RMJC&source=url][b]Paypal Donations[/b] [/url]\n[url=https://subscribestar.adult/neosate-crimsonfang]SubscribStar[/url]\n",
"description_bbcode_parsed": "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
",
"writing": "[code]'Sub word2bb()\n'\n' word2bb Macro\n'\n'\n'Word2BBCode-Converter v0.1, June 2, 2019\n'Some parts adapted from\n'Word2Wiki-Converter V0.4, May 28, 2006\n'http://de.wikipedia.org/wiki/Wikipedia:Helferlein/Word2MediaWikiPlus\n'Original Version by InfPro: http://www.infpro.com/downloads/downloads/wordmedia.htm\n'Major improvements by Gunter Schmidt, Mail me: Word2MediaWikiPlus@beadsoft.de\n'Works only with Word 2000 and above\n'License: GPL: Feel free to use and modify. Keep the credits and do not sell.\n\nSub Word2BBCode()\n \n Application.ScreenUpdating = False\n \n ConvertTitle\n ConvertItalic\n ConvertBold\n ConvertUnderline\n ConvertSize\n ConvertLists\n ConvertHyperlinks\n CovertCenter\n ConvertNote\n AddCarriageReturns\n\n \n ActiveDocument.Content.Copy\n \n Application.ScreenUpdating = True\nEnd Sub\nPrivate Sub ConvertBold()\n ActiveDocument.Select\n \n With Selection.Find\n \n .ClearFormatting\n .Font.Bold = True\n .Text = \"\"\n \n .Format = True\n .MatchCase = False\n .MatchWholeWord = False\n .MatchWildcards = False\n .MatchSoundsLike = False\n .MatchAllWordForms = False\n \n .Forward = True\n .Wrap = wdFindContinue\n \n Do While .Execute\n With Selection\n If InStr(1, .Text, vbCr) Then\n ' Just process the chunk before any newline characters\n ' We'll pick-up the rest with the next search\n .Font.Bold = False\n .Collapse\n .MoveEndUntil vbCr\n End If\n \n ' Don't bother to markup newline characters (prevents a loop, as well)\n If Not .Text = vbCr Then\n .InsertBefore \"[b]\"\n .InsertAfter \"[/b]\"\n End If\n \n .Font.Bold = False\n End With\n Loop\n End With\nEnd Sub\nPrivate Sub ConvertItalic()\n ActiveDocument.Select\n \n With Selection.Find\n \n .ClearFormatting\n .Font.Italic = True\n .Text = \"\"\n \n .Format = True\n .MatchCase = False\n .MatchWholeWord = False\n .MatchWildcards = False\n .MatchSoundsLike = False\n .MatchAllWordForms = False\n \n .Forward = True\n .Wrap = wdFindContinue\n \n Do While .Execute\n With Selection\n If InStr(1, .Text, vbCr) Then\n ' Just process the chunk before any newline characters\n ' We'll pick-up the rest with the next search\n .Font.Italic = False\n .Collapse\n .MoveEndUntil vbCr\n End If\n \n ' Don't bother to markup newline characters (prevents a loop, as well)\n If Not .Text = vbCr Then\n .InsertBefore \"[i]\"\n .InsertAfter \"[/i]\"\n End If\n \n .Font.Italic = False\n End With\n Loop\n End With\nEnd Sub\nPrivate Sub ConvertUnderline()\n ActiveDocument.Select\n \n With Selection.Find\n \n .ClearFormatting\n .Font.Underline = True\n .Text = \"\"\n \n .Format = True\n .MatchCase = False\n .MatchWholeWord = False\n .MatchWildcards = False\n .MatchSoundsLike = False\n .MatchAllWordForms = False\n \n .Forward = True\n .Wrap = wdFindContinue\n \n Do While .Execute\n With Selection\n If InStr(1, .Text, vbCr) Then\n ' Just process the chunk before any newline characters\n ' We'll pick-up the rest with the next search\n .Font.Underline = False\n .Collapse\n .MoveEndUntil vbCr\n End If\n \n ' Don't bother to markup newline characters (prevents a loop, as well)\n If Not .Text = vbCr Then\n .InsertBefore \"[u]\"\n .InsertAfter \"[/u]\"\n End If\n \n .Font.Underline = False\n End With\n Loop\n End With\nEnd Sub\n\n \nPrivate Sub ConvertSize()\n \nDim fSize&\n \n If convertFontSize = False Then Exit Sub\n \n If DefaultFontSize = 12 Then DefaultFontSize = 12\n fSize = 12\n \n For fSize = 1 To 50\n If fSize > DefaultFontSize + 1 Or fSize < DefaultFontSize - 1 Then 'at least two points difference\n ActiveDocument.Select\n With Selection.Find\n \n .ClearFormatting\n .Font.Size = fSize\n .Text = \"\"\n .Format = True\n .MatchCase = False\n .MatchWholeWord = False\n .MatchWildcards = False\n .MatchSoundsLike = False\n .MatchAllWordForms = False\n .Forward = True\n .Wrap = wdFindContinue\n \n Do While .Execute\n With Selection\n \n If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then\n ' Just process the chunk before any newline characters\n ' We'll pick-up the rest with the next search\n .Collapse\n .MoveEndUntil vbCr\n End If\n \n ' Don't bother to markup newline characters (prevents a loop, as well)\n If Not .Text = vbCr Then\n If fSize = DefaultFontSize Then\n .InsertBefore \"[size=\" & fSize & \"]\"\n .InsertAfter \"[/size]\"\n End If\n End If\n \n If useDefaultStyle Then .Style = ActiveDocument.Styles(DefaultStyleName) 'must be localized to your language, see CONST on top\n .Font.Size = DefaultFontSize\n '.Collapse wdCollapseEnd\n '.MoveLeft , 4, True\n 'ClearFormatting\n \n End With\n Loop\n End With\n End If\n Next\n\nEnd Sub\nPrivate Sub ConvertLists()\n Dim para As Paragraph\n For Each para In ActiveDocument.ListParagraphs\n With para.Range\n .InsertBefore \"[List]\"\n For i = 1 To .ListFormat.ListLevelNumber\n If .ListFormat.ListType = wdListBullet Then\n .InsertBefore \"[*]\"\n Else\n .InsertBefore \"[#]\"\n End If\n Next i\n .InsertBefore \"[List]\"\n .ListFormat.RemoveNumbers\n \n End With\n Next para\nEnd Sub\nPrivate Sub ConvertHyperlinks()\n 'converts Hyperlinks\n '24-MAY-2006: only convert http..., mark others with error marker\n\n Dim hyperCount&\n Dim i&\n Dim addr$ ', title$\n\n hyperCount = ActiveDocument.Hyperlinks.Count\n\n For i = 1 To hyperCount\n\n With ActiveDocument.Hyperlinks(1) 'must be 1, since the delete changes count and position\n\n addr = .Address\n If Trim$(addr) = \"\" Then addr = \"no hyperlink found\"\n 'title = .Range.Text\n \n 'http, ftp\n If LCase(Left$(addr, 4)) = \"http\" Or LCase(Left$(addr, 3)) = \"ftp\" Then\n .Delete 'hyperlink\n .Range.InsertBefore \"[url=\" & addr & \"]\"\n .Range.InsertAfter \"[/url]\"\n \n GoTo ConvertHyperlinks_Next\n End If\n \n 'mailto:\n If LCase(Left$(addr, 7)) = \"mailto:\" Then\n .Delete 'hyperlink\n .Range.InsertBefore \"[email]\" & addr & \" \"\n .Range.InsertAfter \"[/email]\"\n \n GoTo ConvertHyperlinks_Next\n End If\n \n 'file guess\n If Len(addr) > 4 Then 'the reason for not nice goto\n If Mid$(addr, Len(addr) - 3, 1) = \".\" Then\n .Delete\n .Range.InsertBefore \"[file://\" & Replace(addr, \" \", \"_\") & \" \"\n .Range.InsertAfter \"]\"\n \n GoTo ConvertHyperlinks_Next\n End If\n End If\n \n 'unidentified\n .Delete\n .Range.InsertBefore UnableToConvertMarker & \"[\" & addr & \" \"\n .Range.InsertAfter \"]\"\n\nConvertHyperlinks_Next:\n End With\n\n Next i\n\nEnd Sub\n\nPrivate Sub CovertCenter()\n Dim Par As Paragraph, Rng As Range\n For Each Par In ActiveDocument.Paragraphs\n If Par.Alignment = wdAlignParagraphCenter Then\n If Rng Is Nothing Then\n Set Rng = Par.Range\n Else\n Rng.End = Par.Range.End\n End If\n Else\n Call CenterFmt(Rng)\n End If\n If Par.Range.End = ActiveDocument.Range.End Then\n Call CenterFmt(Rng)\n End If\n Next\nEnd Sub\n\nPrivate Sub CenterFmt(Rng As Range)\nIf Not Rng Is Nothing Then\n With Rng\n .End = .End - 1\n .InsertBefore \"[center]\"\n .InsertAfter \"[/center]\"\n End With\n Set Rng = Nothing\nEnd If\nEnd Sub\n\nPrivate Sub ConvertTitle()\nApplication.ScreenUpdating = False\nDim Par As Paragraph, Rng As Range\nFor Each Par In ActiveDocument.Paragraphs\n If Par.Style = \"Title\" Then\n If Rng Is Nothing Then\n Set Rng = Par.Range\n Else\n Rng.End = Par.Range.End\n End If\n Else\n Call TitleFmt(Rng)\n End If\n If Par.Range.End = ActiveDocument.Range.End Then\n Call TitleFmt(Rng)\n End If\nNext\nApplication.ScreenUpdating = True\nEnd Sub\n\nPrivate Sub TitleFmt(Rng As Range)\nIf Not Rng Is Nothing Then\n With Rng\n .End = .End - 1\n .InsertBefore \"[t]\"\n .InsertAfter \"[/t]\"\n End With\n Set Rng = Nothing\nEnd If\nEnd Sub\n\nPrivate Sub AddCarriageReturns()\n Dim doc As Document\n Dim para As Paragraph\n\n Set doc = ActiveDocument\n\n For Each para In doc.Paragraphs\n If para.Style = doc.Styles(wdStyleNormal) Then\n para.Range.InsertBefore vbCr\n End If\n Next para\nEnd Sub\n\nPrivate Sub ConvertNote()\n\n Dim Par As Paragraph, Rng As Range\n For Each Par In ActiveDocument.Paragraphs\n If Par.Style = \"Heading 5\" Then\n If Rng Is Nothing Then\n Set Rng = Par.Range\n Else\n Rng.End = Par.Range.End\n End If\n Else\n Call NoteFmt(Rng)\n End If\n If Par.Range.End = ActiveDocument.Range.End Then\n Call NoteFmt(Rng)\n End If\n Next\nEnd Sub\n\nPrivate Sub NoteFmt(Rng As Range)\nIf Not Rng Is Nothing Then\n With Rng\n .End = .End - 1\n .InsertBefore \"[color=#ff0000]\"\n .InsertAfter \"[/colot]\"\n End With\n Set Rng = Nothing\nEnd If\nEnd Sub[/code]\n",
"writing_bbcode_parsed": "'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
",
"pools_count": 1,
"title": "Word to InkBunny BBcode converter",
"deleted": "f",
"public": "t",
"mimetype": "text/plain",
"pagecount": "1",
"rating_id": "0",
"rating_name": "General",
"ratings": [],
"submission_type_id": "12",
"type_name": "Writing - Document",
"guest_block": "t",
"friends_only": "f",
"comments_count": "0",
"views": "90"
}