UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Adding Thousand Separator To Table Cell, Office 2007    
 
   
alysolyman1971
post Jun 8 2020, 02:20 AM
Post#1



Posts: 35
Joined: 2-February 14



Good day!
I need a code that changes the format of numbers in selected cell to : "#,##0"
Currently I'm using the code: Selection.Text = Format$(Selection.Text, "#,##0") but this applies to current cell only. How can I apply the same to multiple cells or numbers at once?

Best Regards and thanks
Go to the top of the page
 
ADezii
post Jun 8 2020, 07:35 AM
Post#2



Posts: 3,087
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. Here is a portable Routine that will allow you to apply a specific Format to any Range of Cells in any Worksheet of the Active Workbook:
    CODE
    Sub FormatRange(shtSheet As String, strRng As String, strNumFormat As String)
    Dim sht As Excel.Worksheet
    Dim rng As Excel.Range

    Set sht = ActiveWorkbook.Worksheets(shtSheet)
    Set rng = sht.Range(strRng)

    sht.Activate
    rng.Select

    Selection.NumberFormat = strNumFormat
    End Sub
  2. Sample Usage:
    CODE
    Call FormatRange("Sheet1", "A1:G20", "#,##0")
    Call FormatRange("Sheet2", "D13:L25", "#,##0.00")
    Call FormatRange("July2020", "A1:AW500", "#,##0.0")
  3. Is this what you are looking for?
Go to the top of the page
 
alysolyman1971
post Jun 8 2020, 01:19 PM
Post#3



Posts: 35
Joined: 2-February 14



Thanks for you reply,

Actually, it's Microsoft Word Not Excel
Would you please update the code for Ms. word
Go to the top of the page
 
ADezii
post Jun 8 2020, 02:19 PM
Post#4



Posts: 3,087
Joined: 4-February 07
From: USA, Florida, Delray Beach


Here are a couple of examples on Formatting a specific Row/Column in a Word Table to a Number Format. No further explanation should be required.
CODE
Dim aTable As Table
Dim aCell As Cell
Dim strCellValue As String

Set aTable = ActiveDocument.Tables(1)

CODE
'Let's Format all Cells in Row 3 only
For Each aCell In aTable.Rows(3).Cells
  'Word adds Chr(13) and Chr(7) at the end of each Table Cell
  'Value, let's get rid of them
  strCellValue = Split(aCell.Range.Text, vbCr)(0)
  
  If IsNumeric(strCellValue) Then
    aCell.Range.Text = Format(strCellValue, "#,##0.00")
  End If
Next

CODE
'Let's Format all Cells in Column 1 only
For Each aCell In aTable.Columns(1).Cells
  'Word adds Chr(13) and Chr(7) at the end of each Table Cell
  'Value, let's get rid of them
  strCellValue = Split(aCell.Range.Text, vbCr)(0)
  
  If IsNumeric(strCellValue) Then
    aCell.Range.Text = Format(strCellValue, "#,##0.00")
  End If
Next
Go to the top of the page
 
alysolyman1971
post Jun 8 2020, 04:21 PM
Post#5



Posts: 35
Joined: 2-February 14



That's great. Thanks.
Can I apply this to a selection within a table. i.e.: I select some cells within the table and after that run the code!
Sorry for any inconvenience.
Thanks in advance
Go to the top of the page
 
ADezii
post Jun 8 2020, 05:59 PM
Post#6



Posts: 3,087
Joined: 4-February 07
From: USA, Florida, Delray Beach


Here is some Code that I came up with that will allow you to select a 'contiguous number of Cells' in a Word Table (as illustrated i the Image) then Run a Macro (Macro1) that will Format all Cells in that Selection.
CODE
Sub Macro1()
Dim strCellValue As String
Dim lngStartRow As Long
Dim lngEndRow As Long
Dim lngStartCol As Long
Dim lngEndCol As Long
Dim lngCtr1 As Long
Dim lngCtr2 As Long

'Is the Selection within Table Boundaries
If Not Selection.Information(wdWithInTable) Then Exit Sub

'Gert Row & Column Start and End Points
lngStartRow = Selection.Information(wdStartOfRangeRowNumber)
lngEndRow = Selection.Information(wdEndOfRangeRowNumber)
lngStartCol = Selection.Information(wdStartOfRangeColumnNumber)
lngEndCol = Selection.Information(wdEndOfRangeColumnNumber)
  
With Selection.Tables(1)
  For lngCtr1 = lngStartRow To lngEndRow
    For lngCtr2 = lngStartCol To lngEndCol
      strCellValue = Split(.Cell(lngCtr1, lngCtr2).Range.Text, vbCr)(0)
        If IsNumeric(strCellValue) Then
          .Cell(lngCtr1, lngCtr2).Range.Text = Format(strCellValue, "#,##0.00")
        End If
    Next
  Next
End With
End Sub

P.S. - I'm sure there is an easier solution, but I am not very familiar with programming in Word.
This post has been edited by ADezii: Jun 8 2020, 06:00 PM
Attached File(s)
Attached File  Word.jpg ( 54.01K )Number of downloads: 0
 
Go to the top of the page
 
alysolyman1971
post Jun 9 2020, 01:03 AM
Post#7



Posts: 35
Joined: 2-February 14



Thaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaanks
Go to the top of the page
 
alysolyman1971
post Jun 9 2020, 01:10 AM
Post#8



Posts: 35
Joined: 2-February 14



Last favor please from your kindness,
when sum numbers are between parenthesis like this (2000), the number is reformatted with separator but parenthesis are removed and replaced with negative sign "-".
I'm sure I disturbed you but this is my last request.
Go to the top of the page
 
ADezii
post Jun 9 2020, 06:53 AM
Post#9



Posts: 3,087
Joined: 4-February 07
From: USA, Florida, Delray Beach


Are you referring to the Formatting of Negative Numbers? Do you want to keep Negatives within the parenthesis and eliminate the Negative Sign, as in: (1,234)?
Go to the top of the page
 
alysolyman1971
post Jun 9 2020, 09:16 AM
Post#10



Posts: 35
Joined: 2-February 14



Yes please!
ex. (1234) shall be (1,234) with the parentheses .
Thanks again
Go to the top of the page
 
cheekybuddha
post Jun 9 2020, 10:01 AM
Post#11


UtterAccess Moderator
Posts: 13,006
Joined: 6-December 03
From: Telegraph Hill


Hi,

Adjust this:
CODE
' ...
        If IsNumeric(strCellValue) Then
          .Cell(lngCtr1, lngCtr2).Range.Text = Format(strCellValue, "#,##0.00;(#,##0.00)")
        End If
' ...


hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
alysolyman1971
post Jun 9 2020, 11:54 AM
Post#12



Posts: 35
Joined: 2-February 14



I don't know how to thank you for your efforts.
Best regards
Go to the top of the page
 
cheekybuddha
post Jun 9 2020, 01:01 PM
Post#13


UtterAccess Moderator
Posts: 13,006
Joined: 6-December 03
From: Telegraph Hill


yw.gif

--------------------


Regards,

David Marten
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    6th July 2020 - 04:01 AM