View Single Post
 
Old 06-05-2022, 02:47 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Windows 10 Office 2019
Competent Performer
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 200
Cendrinne is on a distinguished road
Default OK now I found part 2, as of column 2....

Mind you, I've based myself on an incredible script done by @Greg Maxey
HTML Code:
https://gregmaxey.com/website_feedback_contact.html
Thank you Greg to have guided me

Note, let me describe my tables though:
1st column has text bla bla bla;
2nd column = Numbers (amounts);
3rd column = symbols either or and ($%);
4th column and 5th columns are a repeat of the 2nd and 3rd column

So this macro affects the size of the columns of amounts and of symbols + puts a gab (space) between the amounts and the symbols.

What I wanted or needed help with was allowing the amounts to aligned perfectly if there is a negative amount. (part 1), which I've succeeded on all tables in the document.

Part 2 was as of column 2, which I've succeeded:

I'm not a pro in scripting, however I have a determination that won't end. With the help of wonderful people here I've met on this site, with my analytical mind, with Trial and Error, I've done it. I know it could probably done better, so with no scripting skills, here is my version of it.

Code:
Dim oTbl As Table
Dim lngRow As Long, lngCol As Long
Dim oRng As Range
Dim oCell As Cell

  Application.ScreenUpdating = False
 'Set oTbl = Selection.Tables(1)
     
      For Each oTbl In ActiveDocument.Tables
      
      oTbl.AutoFitBehavior (wdAutoFitFixed)
  Set oRng = oTbl.Range
    
    oRng.Start = oTbl.Columns(1).Cells(1).Range.Start
    oRng.Select
    
    For lngCol = 2 To oTbl.Columns.Count                               
      
      If lngCol Mod 2 = 0 Then
        'Odd columns starting with 1.
        oTbl.Columns(lngCol).PreferredWidth = InchesToPoints(0.8)
        TTfr_ALIGN_COLN_FormatColumnCells08 oTbl.Columns(lngCol), "Right"
      Else
        'Even columns starting with 2.
        oTbl.Columns(lngCol).PreferredWidth = InchesToPoints(0.12)
        TTfr_ALIGN_COLN_FormatColumnCells08 oTbl.Columns(lngCol), "Left"
      End If
    Next lngCol
  
  TTfr_ALIGNE_TT_Nbrs_Neg_0v04
  
     Next oTbl
  
lbl_Exit:
  Set oTbl = Nothing: Set oRng = Nothing: Set oCell = Nothing
  Exit Sub
  
  Application.ScreenUpdating = True
Code:
Sub TTfr_ALIGN_COLN_FormatColumnCells08(Col As Column, Align As String)
'Rec'vd from Greg 2019-09-21 **Good 
'Part 2 of 2
  
  Application.ScreenUpdating = False

Dim oCell As Cell
  For Each oCell In Col.Cells
    With oCell.Range
      .Cells.VerticalAlignment = wdAlignVerticalBottom
      .ParagraphFormat.LeftIndent = InchesToPoints(0)
      If Align = "Right" Then
        .ParagraphFormat.Alignment = wdAlignParagraphRight
        .ParagraphFormat.RightIndent = InchesToPoints(0.08)
      Else
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .ParagraphFormat.RightIndent = InchesToPoints(0)
      End If
    
    End With
  Next oCell
lbl_Exit:
  Exit Sub

  Application.ScreenUpdating = True
End Sub
Code:
Sub TTfr_ALIGNE_TT_Nbrs_Neg_0v04()
'Based on a basic Word macro coded by Greg Maxey 2019-09-22
  
  Application.ScreenUpdating = False

Dim xTbl As Table
Dim aCel As Cell
Dim oRng As Range

For Each xTbl In ActiveDocument.Range.Tables
  For Each aCel In xTbl.Range.Cells
      If aCel.Range.Characters.First = "(" Then
        aCel.Range.ParagraphFormat.RightIndent = InchesToPoints(0.04)
        
        Else
        
      End If
      
  Next aCel

Next
  Application.ScreenUpdating = True
  Application.ScreenRefresh
  DoEvents
  
lbl_Exit:
  Set xTbl = Nothing
  Set oRng = Nothing
  Exit Sub
  
  On Error GoTo 0
  
  Application.ScreenUpdating = True
  
End Sub
Other important note, this should not include merge columns, so split them up before using these macros. Then put them back together

I want to thank you all to have helped me. I do get better and better with time.

I amaze myself

What do you think?

Cendrinne
Reply With Quote