I am placing activex progress bars (PB) in a range of cells setting the
colors of the PB based on content of other cells. At first, my problem was
when one (or more) cells height are large I would get this error "'Run-time
'-2147467259 (80004005)'; Method 'Scrolling' of object 'IprogressBar'
failed". MS said this error was do to a refresh rate issue and to trap the
error with a resume. This will wait until the screen is refreshed. This
solution stops the 'run-time error' message, but I can't change the color of
the problem PB. Here's my code that Adds the Progress Bar with the Error
Handler.
The problem seems to be a function of the size of the range (number of
cells) and the number of cells at larger heights.

Public Sub AddProgressBar(rCell As Range)
Dim OLEObj As OLEObject

With rCell
Set OLEObj = .Parent.OLEObjects.Add _
(ClassType:="MSComctlLib.ProgCtrl.2", _
Left:=.Left, Top:=.Top, _
Width:=.Width + 1, Height:=.Height + 1)
End With

Call setBarColors("white") sets the BarColors type used below
'On Error GoTo Err_Progress
With OLEObj
.Placement = xlMoveAndSize
.Visible = True
With .Object
Call SetProgressBackColor(.hwnd, RGB(BarColors.Red, BarColors.Green,
BarColors.Blue))
.Min = 0
.Max = 1
.Value = 0
.Appearance = ccFlat
.BorderStyle = ccFixedSingle
.MousePointer = ccDefault
.OLEDropMode = ccOLEDropNone
.Orientation = ccOrientationHorizontal
.Scrolling = ccScrollingSmooth
End With
End With
On Error GoTo 0

Exit Sub

Err_Progress:
Debug.Print "AddProgressBar", Err.Number
If Err.Number = -2147467259 Then
Resume 'until control is visible.
Else
MsgBox "Error displaying Progress Bar", vbCritical + vbOKOnly
Err = 0
On Error GoTo 0
End If
End Sub

Any inputs/suggestions appreciated.
- Pat

I can't replicate your first problem but I expect the reason you appear not
to be able to change the colour is because you are changing Scrolling after
applying your custom colour (SendMessage I assume). So apply your colour
after changing all the PB properties.

Regards,
Peter T


"Dreiding" wrote in message
...
I am placing activex progress bars (PB) in a range of cells setting the
colors of the PB based on content of other cells. At first, my problem
was
when one (or more) cells height are large I would get this error
"'Run-time
'-2147467259 (80004005)'; Method 'Scrolling' of object 'IprogressBar'
failed". MS said this error was do to a refresh rate issue and to trap
the
error with a resume. This will wait until the screen is refreshed. This
solution stops the 'run-time error' message, but I can't change the color
of
the problem PB. Here's my code that Adds the Progress Bar with the Error
Handler.
The problem seems to be a function of the size of the range (number of
cells) and the number of cells at larger heights.

Public Sub AddProgressBar(rCell As Range)
Dim OLEObj As OLEObject

With rCell
Set OLEObj = .Parent.OLEObjects.Add _
(ClassType:="MSComctlLib.ProgCtrl.2", _
Left:=.Left, Top:=.Top, _
Width:=.Width + 1, Height:=.Height + 1)
End With

Call setBarColors("white") sets the BarColors type used below
'On Error GoTo Err_Progress
With OLEObj
.Placement = xlMoveAndSize
.Visible = True
With .Object
Call SetProgressBackColor(.hwnd, RGB(BarColors.Red, BarColors.Green,
BarColors.Blue))
.Min = 0
.Max = 1
.Value = 0
.Appearance = ccFlat
.BorderStyle = ccFixedSingle
.MousePointer = ccDefault
.OLEDropMode = ccOLEDropNone
.Orientation = ccOrientationHorizontal
.Scrolling = ccScrollingSmooth
End With
End With
On Error GoTo 0

Exit Sub

Err_Progress:
Debug.Print "AddProgressBar", Err.Number
If Err.Number = -2147467259 Then
Resume 'until control is visible.
Else
MsgBox "Error displaying Progress Bar", vbCritical + vbOKOnly
Err = 0
On Error GoTo 0
End If
End Sub

Any inputs/suggestions appreciated.
- Pat