Tabs for bullets inside table

P

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
 
J

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
 
P

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.
 
P

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
-------------------------
 
P

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

------------------------------
 
P

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


-----------------------
 
P

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!!!
 
P

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Copying text from Word table to Powerpoint Table 2
Tabs and Bullets 1
PowerPoint 2003 Bullets 1
I'd like tab to set indent for bullets but not for paragraphs 1
Unable to indent bullets as paragraphs when using VBA in PowerPoin 5
Level two bullets in PPT table 0
there are bullets in my captions - ?? 3
when I try to bullet one line, all bullets for every line 0

Top