[dba-Tech] would an array be best for this?

Stuart,
Thanks a bunch! That sparked my brain. BTW the InputBox and other items are
general VBA - none of what you posted it was Access specific.

I owe you one - John B.


Here's my (almost) final code. (I have an issue with one set of bullet
characters in a list. I will have find out whether there is some exception
to how they may need to be handled. It could an import from an older version
or soemthing.)

'Code: WinHaven LLC  Last Update: 2-9-05   Thanks to Shyam Pillai and Stuart
McLachlan for their most kind assistance
Option Explicit
Public intCountObjects As Integer

Sub ProcessShapes()
'Loops through all objects in a PowerPoint presentation and changes the
color to grayscale (unless noted as an exception)

Dim objSlide As Slide
Dim objShape As Shape
Dim I As Integer
Dim intUseGray As Integer
Dim lngNewRGB As Long
Dim strPages() As String
Dim strSkipPages As String
Dim lngLoop As Long

'ask user for the slide numbers that aren't to be processed
strSkipPages = InputBox("Enter the slide numbers that you do not want
converted to grayscale." & vbCrLf & vbCrLf & _
"Separated the slide numbers with commas." & vbCrLf & vbCrLf & _
"Example: 1,5,12,35,67", "Special Process - Convert Pages to Gray: List
Exceptions", , 3600, 3600)
'strip out any spaces
strSkipPages = StripChars_TSB(strSkipPages, " ") 'in another module
'use split and join to change format of each element to three digits
'build array
strPages() = Split(strSkipPages, ",")
'pad elements
For lngLoop = 0 To UBound(strPages())
    strPages(lngLoop) = Right$("000" & strPages(lngLoop), 3)
Next
'Rebuild String
strSkipPages = Join(strPages(), ",")
For Each objSlide In ActivePresentation.Slides
    intCountObjects = intCountObjects + 1 'running count of objects
    'test whether we should process this slide
    If InStr(strSkipPages, Format$(objSlide.SlideNumber, "000")) = 0 Then
    '---------------------------------------------
    For Each objShape In objSlide.Shapes
        intCountObjects = intCountObjects + 1 'running count of objects
        If objShape.Type = msoGroup Then
            For I = 1 To objShape.GroupItems.count
                intCountObjects = intCountObjects + 1 'running count of
objects
                Call ChangeToGray(objShape.GroupItems(I))
            Next I
        Else
            Call ChangeToGray(objShape)
        End If
    Next objShape
    End If
Next objSlide
MsgBox intCountObjects & " objects have been processed to gray scale.",
vbOKOnly, "Convert Pages to Gray: Complete!"

End Sub

Function CalcGray(lngRGB As Long) As Long
'find rgb values divide by three to get a gray tone value to return

Dim lngRed As Long
Dim lngGreen As Long
Dim lngBlue As Long
Dim lngGray As Long
Dim intGray As Integer

    lngRed = lngRGB Mod 256
    lngGreen = lngRGB \ 256 Mod 256
    lngBlue = lngRGB \ 65536 Mod 256
    lngGray = (lngRed + lngGreen + lngBlue)
    If lngGray <> 0 Then
        lngGray = (lngGray / 3)
    End If

intGray = CInt(lngGray)

CalcGray = RGB(intGray, intGray, intGray)

End Function

Function ChangeToGray(objShape As Shape)

    Dim lngNewRGB As Long
    Dim I As Integer
    Dim oTxtRng As TextRange
    On Error Resume Next
    If objShape.HasTextFrame Then
        'change text objects
        If objShape.TextFrame.HasText Then
            Set oTxtRng = objShape.TextFrame.TextRange
            For I = 1 To oTxtRng.Runs.count
                intCountObjects = intCountObjects + 1 'running count of
objects
                With oTxtRng.Runs(I).Font.Color
                        lngNewRGB = CalcGray(.RGB)
                        .RGB = lngNewRGB
                End With
            Next I
        End If
    End If
    If objShape.Fill.Visible Then
        'forecolor fill
        lngNewRGB = CalcGray(objShape.Fill.ForeColor.RGB)
        objShape.Fill.ForeColor.RGB = lngNewRGB
        'backcolor fill
        lngNewRGB = CalcGray(objShape.Fill.BackColor.RGB)
        objShape.Fill.BackColor.RGB = lngNewRGB
    End If
    If objShape.Line.Visible Then
        'line color
        lngNewRGB = CalcGray(objShape.Line.ForeColor.RGB)
        objShape.Line.ForeColor.RGB = lngNewRGB
    End If
    'picture color
    objShape.PictureFormat.ColorType = msoPictureGrayscale
    
End Function