Skip to content

Instantly share code, notes, and snippets.

@sandraros
Last active January 19, 2019 19:51
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sandraros/eff5869b60ab1639efa3f2ca16652043 to your computer and use it in GitHub Desktop.
Save sandraros/eff5869b60ab1639efa3f2ca16652043 to your computer and use it in GitHub Desktop.
VBA macro to paste into MS Word, which converts text lines with tab characters representing tables into tables without tab, but instead with values right-padded with spaces (markdown version too) so that to fit perfectly for usage of HTML <pre>...</pre>
Rem 1) select the text lines representing a table whose columns are separated by the tab character
Rem 2) run this macro
Rem 3) result: the tab characters are replaced by two or more space characters such a way each column
Rem has the same number of characters
Rem 4) you may then copy/paste those text lines inside HTML <pre>...</pre> it will look like a table
Sub tabs_to_spaces()
Dim par As Paragraph
Dim pars() As Paragraph
Dim arr(50) As Integer ' 50 tabs maximum per line
Application.ScreenUpdating = False
max_ztab = -1
For Each par In Selection.Paragraphs
old_x = 1
ztab = LBound(arr)
Do While old_x <> 0
x = InStr(old_x, par.Range.Text, Chr(9))
If x = 0 Then
zlen = Len(par.Range.Text) - old_x + 1
Else
zlen = x - old_x
End If
If zlen > arr(ztab) Then arr(ztab) = zlen
If ztab > max_ztab Then max_ztab = ztab
ztab = ztab + 1
If x = 0 Then
Exit Do
Else
old_x = x + 1
End If
Loop
Next
ReDim pars(Selection.Paragraphs.Count)
For i = 1 To Selection.Paragraphs.Count
Set pars(i) = Selection.Paragraphs(i)
Next
For i = 1 To UBound(pars)
Set par = pars(i)
old_x = 1
ztab = LBound(arr)
Do
x = InStr(old_x, par.Range.Text, Chr(9))
If x = 0 Then
Exit Do
End If
Call par.Range.Characters(x).Delete
zlen = arr(ztab) - (x - old_x) + 2 ' + 2 spaces between each column
ztab = ztab + 1
Call par.Range.Characters(x).InsertBefore(Space(zlen))
old_x = x + zlen
Loop
Next
Application.ScreenUpdating = True
End Sub
Sub tabs_to_markdown()
Dim par As Paragraph
Dim pars() As Paragraph
Dim arr(50) As Integer ' 50 tabs maximum per line
Application.ScreenUpdating = False
' calculate array "arr" containing column widths, and max_ztab
max_ztab = -1
For Each par In Selection.Paragraphs
old_x = 1
ztab = LBound(arr)
Do While old_x <> 0
x = InStr(old_x, par.Range.Text, Chr(9))
If x = 0 Then
zlen = Len(par.Range.Text) - old_x + 1
Else
zlen = x - old_x
End If
If zlen > arr(ztab) Then arr(ztab) = zlen
If ztab > max_ztab Then max_ztab = ztab
ztab = ztab + 1
If x = 0 Then
Exit Do
Else
old_x = x + 1
End If
Loop
Next
ReDim pars(Selection.Paragraphs.Count)
For i = 1 To Selection.Paragraphs.Count
Set pars(i) = Selection.Paragraphs(i)
Next
For i = 1 To UBound(pars) ' CAUTION must be 1, not lbound(pars)
Set par = pars(i)
Call par.Range.InsertBefore("| ")
old_x = 1 + Len("| ")
ztab = LBound(arr)
While old_x < par.Range.Characters.Count
' get the position of the next TAB character
x = InStr(old_x, par.Range.Text, Chr(9))
If x <> 0 Then
' delete the TAB character
Call par.Range.Characters(x).Delete
Else
x = par.Range.Characters.Count
End If
' insert
column_right = Space(arr(ztab) - (x - old_x) + 1) + "| "
Call par.Range.Characters(x).InsertBefore(column_right)
old_x = x + Len(column_right)
' next column
ztab = ztab + 1
Wend
Next
Application.ScreenUpdating = True
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment