Tabs for bullets inside table

[Prasant]

Hi there,

Looking for something which I believe can't get. But still have hope as
experts are in here...

We will be having many tables with bullet points. Indenting bullets is a big
problem. We need to go inside each cell give indent for each and every cell
which takes lot of time. Copy and Paste formatting still needs indenting.
Copying bullet and copying text as unformatted text is also a laborious. Is
it possible to create a macro with a button (or shortcut key will be great)
which captures the first indent given and applies to all other cells in the
entire table?

I tried recording but it is not working. Simply what I need is, if I give
indent to one cell, it should apply to the entire table either through a
macro or any alternate procedure but in seconds.

Your ideas are appreciated with respect.

Thanks

 

[John Wilson]

You'd probably want to mention which version of PPT this is for Prasant.
--
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.uk
http://www.technologytrish.co.uk
email john AT technologytrish.co.uk

 

[Prasant]

OOPS...sorry to miss that...I'm using 2003.

Prasant
---------

 

[John Wilson]

Prasant

This is "top of my head" code but it should get you close

Sub formattable()
'reads indent from cell 1,1 and transfers to all
Dim otbl As Table
Dim Irow As Integer
Dim Icol As Integer
Dim Ibullet As Integer
Dim lngFirst As Long
Dim lngLeft As Long
Dim boolBullet As Boolean
' ignore error is no selection or not table
On Error Resume Next
Set otbl = ActiveWindow.Selection.ShapeRange(1).Table
With otbl.Cell(1, 1).Shape.TextFrame
lngLeft = .Ruler.Levels(1).LeftMargin
lngFirst = .Ruler.Levels(1).FirstMargin
End With
For Irow = 1 To otbl.Rows.Count
For Icol = 1 To otbl.Columns.Count
With otbl.Cell(Irow, Icol).Shape.TextFrame
..TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered
..Ruler.Levels(1).LeftMargin = lngLeft
..Ruler.Levels(1).FirstMargin = lngFirst
End With
Next Icol
Next Irow
End Sub

Set the first cell as required, select the table and run code.
--
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.uk
http://www.technologytrish.co.uk
email john AT technologytrish.co.uk

 

[Prasant]

Hey John

GREAT...it worked....You are GOD!!!


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

 

[Prasant]

Desires will never stop....
Can you give me any code to assign a particular macro to a keyboard function
or shortcutkey? I created some macros which I want to assign important ones
to a keyboard.

 

[John Wilson]

That's not something I think you are going to be able to code yourself. There
is a pretty cheap Add In though from Chiraq at OfficeOne which I think would
do it (I don't have it)
http://officeone.mvps.org/ppsctmgr/ppsctmgr.html
--
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.uk
http://www.technologytrish.co.uk
email john AT technologytrish.co.uk

 

[Prasant]

Hi John

That's fine. Will create the buttons. About the table, it is working fine.
But it is taking from the first cell. Now here we have a table headers in the
first row and the bullets below each heading. So I changed it to Cell (2,1)
and it worked from second row. But it is also getting applied to the top row
which actually is a heading. I tried to disable the button feature for the
first row but failed. I also need to color the first row. So how can I add
code which will remove bullets for the first row and add color.

I know you will definetely have a solution. Please give me those magic lines.


Thanks
-------------------------

 

[John Wilson]

Maybe

For IRow= 2 to otbl.Rows.Count
--
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.uk
http://www.technologytrish.co.uk
email john AT technologytrish.co.uk

 

[Prasant]

John,

How can I include to capture a sub bullet too, in this coding? I tried
adding this but it is not getting correct indentation.
Dim lngSecond As Long
lngLeft = .Ruler.Levels(2).LeftMargin
lngSecond = .Ruler.Levels(2).FirstMargin

Prasant

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

 

[Prasant]

Hey ...I got that!!

Dim lngLeft2 As Long
Dim lngSecond As Long
lngLeft2 = .Ruler.Levels(2).LeftMargin
lngSecond = .Ruler.Levels(2).FirstMargin
..Ruler.Levels(2).LeftMargin = lngLeft2
..Ruler.Levels(2).FirstMargin = lngSecond


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

 

[Prasant]

John,

I'm still facing the problem with the table header. The script is working
for the entire table and I made below edits to that so that it applies to sub
bullets too. But I'm unable to remove the bullet to the header which is the
first row.

Please help me!!!

 

[Prasant]

Hey I got the entire code...bullets for level 1, 2 and 3 and no bullets for
header. Here is the modified code...

Sub tablebullets()
Dim otbl As Table
Dim Irow As Integer
Dim Icol As Integer
Dim Ibullet As Integer
Dim lngFirst As Long
Dim lngLeft As Long
Dim lngSecond As Long
Dim lngThird As Long
Dim lngLeft2 As Long
Dim lngLeft3 As Long
Dim boolBullet As Boolean
On Error Resume Next
Set otbl = ActiveWindow.Selection.ShapeRange(1).Table
With otbl.Cell(2, 1).Shape.TextFrame
lngLeft = .Ruler.Levels(1).LeftMargin
lngFirst = .Ruler.Levels(1).FirstMargin
lngLeft2 = .Ruler.Levels(2).LeftMargin
lngSecond = .Ruler.Levels(2).FirstMargin
lngLeft3 = .Ruler.Levels(3).LeftMargin
lngThird = .Ruler.Levels(3).FirstMargin
End With
For Irow = 1 To otbl.Rows.Count
For Icol = 1 To otbl.Columns.Count
With otbl.Cell(Irow, Icol).Shape.TextFrame
..TextRange.ParagraphFormat.Bullet.Type = ppBulletUnnumbered
..Ruler.Levels(1).LeftMargin = lngLeft
..Ruler.Levels(1).FirstMargin = lngFirst
..Ruler.Levels(2).LeftMargin = lngLeft2
..Ruler.Levels(2).FirstMargin = lngSecond
..Ruler.Levels(3).LeftMargin = lngLeft3
..Ruler.Levels(3).FirstMargin = lngThird
End With
With otbl.Cell(1, Icol).Shape.TextFrame
..TextRange.ParagraphFormat.Bullet.Type = ppBulletNone
End With
Next Icol
Next Irow
End Sub