Solved: Tags or Names

[dumbpuppy]

In Case anyone is interested, I thought I'd share a piece of code I cobbled together from other examples to fit my needs. I found it a bit overwhelming when you start working with tags which can exist at different levels and multiple time per slide and/or shape. Anyhow, this code will iterate through the current slide and display the Name and Value for each tag. Anyone else with any pearls of wisdom or useful "Tag" snippets please share...

Sub ViewAllTags()
Dim oSh As Shape
Set oSh = Nothing
Dim sName As String
Dim lCurrSlide As Long
lCurrSlide = ActiveWindow.Selection.SlideRange.SlideIndex
'Slide Level Tag Iteration
With Application.ActivePresentation.Slides(lCurrSlide).Tags
    For i = 1 To .Count
        MsgBox "Slide Tag #" & i & ": Name = " & .Name(i) _
        & Chr$(13) & "Tag #" & i & ": Value = " & .Value(i)
    Next
End With
'Shape Level Tag Iteration
For Each oSh In Application.ActivePresentation.Slides(lCurrSlide).Shapes
    On Error Resume Next
    For j = 1 To oSh.Tags.Count
        oSh.Select 'Used only for viewing purposes - can delete
        MsgBox "Shape Tag Name #" & j & ": Name = " & oSh.Tags.Name(j) _
        & Chr$(13) & "Tag #" & j & ": Value = " & oSh.Tags.Value(j)
    Next
Next
End Sub

Also, Below is a pretty cool piece of code which started out as a thermometer example. I altered the code for my purposes and enhanced it to use Tags instead of names. The code accepts x as a percentage complete parameter to draw the progress bar. Anyone have any suggestion for me to improve the code feel free to help me improve my code base. The nice thing about the tags implementation is that I used "Progress" as the name for all related shapes. The unique property is the value. This makes it much easier to do things like move or delete the Progress Bar. Enjoy..

Sub AddOneBar(x As Long)
Dim dblLeft As Double
Dim dblTop As Double
Dim dblheight As Double
Dim dblNetWidth As Double
Dim oSh As Shape
Dim oSh2 As Shape
Dim oLine As Shape
Dim i As Double
Dim slideName As String
slideName = ActiveWindow.Selection.SlideRange.Name
' This determines how far in from left the progress bar will start:
dblLeft = 10
' This determines how high (in points) the progress bar will be:
dblheight = 25
' This puts the progress bar right against the bottom of the slide, no matter what its height
dblTop = ActivePresentation.PageSetup.SlideHeight - dblheight - 25
'Net Width of ProgressBar
dblNetWidth = ActivePresentation.PageSetup.SlideWidth - dblLeft - 10
Set oSh = ActivePresentation.Slides(slideName).Shapes.AddShape(msoShapeRectangle, _
dblLeft, _
dblTop, _
((x / 100) * dblNetWidth), _
dblheight)
oSh.Fill.ForeColor.RGB = RGB(0, 255, 0)
oSh.Fill.Visible = msoTrue
oSh.Tags.Add "Progress", "Area"
Set oSh2 = ActivePresentation.Slides(slideName).Shapes.AddShape(msoShapeRectangle, _
dblLeft, _
dblTop, _
dblNetWidth, _
dblheight)
oSh2.Line.Weight = 3
oSh2.Line.ForeColor.RGB = RGB(0, 0, 0)
oSh2.Line.Visible = msoTrue
oSh2.Tags.Add "Progress", "Outline"
'Add Tick Mark
i = 0
For i = 1 To 9
    Set oLine = ActivePresentation.Slides(slideName).Shapes.AddLine( _
    (i * 10 / 100 * dblNetWidth) + dblLeft, _
    dblTop, (i * 10 / 100 * dblNetWidth) + dblLeft, dblTop + 10)
    oLine.Line.Weight = 2
    Works oLine.Tags.Add "Progress", "tickline" & I
    oLine.Line.Visible = msoTrue
Next i
End Sub

Edited 12-Sep-07 by geekgirlau. Reason: insert VBA tags