D
Dreiding
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
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