Howdy
Hope you had a great Christmas (for those of you that celebrate it)!

Back at work now! Got a problem.

I programmatically create 4 columns by 30 rows of (control) form elements,
and the form elements are either a checkbox or are a label with the ASCII
character returned by VBA Chr(254) and set to Wingdings font (which SHOULD
show a "non-clickable" checkbox).

(Whether it is a label or a checkbox form element depends on a True or False
value in a corresponding 4 x 30 matrix on another worksheet.)

The problem is that only some of my Labels show the "unclickable" checkbox,
whilst the other labels show the Chr(254) NOT formatted in Wingdings font
(in what must be the default font of Arial), even though in the Properties
for the label it does actually say that the label has it's Font set to
Wingdings...!!! There does not appear to be any pattern to which of the
labels show a checkbox and which show the ASCII character without the
Wingdings font even though it says it is Wingdings...???

Seems like a bug. It happens on both Excel 97 and 2002.

Any idea what the problem is and how to fix it?

Thanks a lot
Matt

Try DoEvents after setting the font name, or after setting the label
caption which ever is later.

Sharad

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Hi Matt

My unfortunate experiences a If you repeatedly add and delete objects in
a workbook, they don't delete properly and hidden junk piles up somewhere
inaccessible. The workbook becomes unstable after a while until it becomes
corrupted beyond hope.

Otherwise, lots of controls in a worksheet is very demanding on graphical
resources and things like this can happen in the "display" part of Excel.
Make sure you don't have multiple windows open and that zoom is nothing but
100%.

Apologies for the unscientific reply.
HTH. Best wishes Harald

"Matt Jensen" skrev i melding
...
Howdy
Hope you had a great Christmas (for those of you that celebrate it)!

Back at work now! Got a problem.

I programmatically create 4 columns by 30 rows of (control) form elements,
and the form elements are either a checkbox or are a label with the ASCII
character returned by VBA Chr(254) and set to Wingdings font (which SHOULD
show a "non-clickable" checkbox).

(Whether it is a label or a checkbox form element depends on a True or
False
value in a corresponding 4 x 30 matrix on another worksheet.)

The problem is that only some of my Labels show the "unclickable"
checkbox,
whilst the other labels show the Chr(254) NOT formatted in Wingdings font
(in what must be the default font of Arial), even though in the Properties
for the label it does actually say that the label has it's Font set to
Wingdings...!!! There does not appear to be any pattern to which of the
labels show a checkbox and which show the ASCII character without the
Wingdings font even though it says it is Wingdings...???

Seems like a bug. It happens on both Excel 97 and 2002.

Any idea what the problem is and how to fix it?

Thanks a lot
Matt

G'day Sharad and Harald

I've done some testing since including using implications of your answers,
and after noticing that whilst there was no pattern of which ones were
formatted correctly vs. incorrectly, I noticed that it always happened in
the same places.

I deleted every VBA reference to Wingdings and discovered that some remnants
of earlier developing had randomly left font face settings on the *cells*
below and this was driving the label above's font face!!

Now I've found that the pattern for which was formatted correctly and which
wasn't is directly related to the Font setting for the cell below the
label!!

I've fixed that and now it seems to be all good! Hooray!! Seems strange
though...

One problem that remains though (and is somewhat different from this problem
but still relevant to it) is that, even though at the start of the proc I
have Application.Screenupdating = False & (pseudo code) cursor=hourglass and
set it back to true and xldefault at the end of the proc respectively,
setting the *caption* of the label occurs after (it appears) that the proc
has finished (cursor goes back to default AND is visible onscreen), which is
not good at all and what I would have thought screenupdating prevented from
happening....? I thought DoEvents may have helped with this, but it doesn't!

Any way of stopping this?
Thanks again a lot
Cheers
Matt


"Harald Staff" wrote in message
...
Hi Matt

My unfortunate experiences a If you repeatedly add and delete objects
in
a workbook, they don't delete properly and hidden junk piles up somewhere
inaccessible. The workbook becomes unstable after a while until it becomes
corrupted beyond hope.

Otherwise, lots of controls in a worksheet is very demanding on graphical
resources and things like this can happen in the "display" part of Excel.
Make sure you don't have multiple windows open and that zoom is nothing
but
100%.

Apologies for the unscientific reply.
HTH. Best wishes Harald

"Matt Jensen" skrev i melding
...
Howdy
Hope you had a great Christmas (for those of you that celebrate it)!

Back at work now! Got a problem.

I programmatically create 4 columns by 30 rows of (control) form
elements,
and the form elements are either a checkbox or are a label with the
ASCII
character returned by VBA Chr(254) and set to Wingdings font (which
SHOULD
show a "non-clickable" checkbox).

(Whether it is a label or a checkbox form element depends on a True or
False
value in a corresponding 4 x 30 matrix on another worksheet.)

The problem is that only some of my Labels show the "unclickable"
checkbox,
whilst the other labels show the Chr(254) NOT formatted in Wingdings
font
(in what must be the default font of Arial), even though in the
Properties
for the label it does actually say that the label has it's Font set to
Wingdings...!!! There does not appear to be any pattern to which of the
labels show a checkbox and which show the ASCII character without the
Wingdings font even though it says it is Wingdings...???

Seems like a bug. It happens on both Excel 97 and 2002.

Any idea what the problem is and how to fix it?

Thanks a lot
Matt

"Matt Jensen" skrev i melding
...
I've fixed that and now it seems to be all good! Hooray!! Seems strange
though...

Well spotted, well done.

One problem that remains though (and is somewhat different from this
problem
but still relevant to it) is that, even though at the start of the proc I
have Application.Screenupdating = False & (pseudo code) cursor=hourglass
and
set it back to true and xldefault at the end of the proc respectively,
setting the *caption* of the label occurs after (it appears) that the proc
has finished (cursor goes back to default AND is visible onscreen), which
is
not good at all and what I would have thought screenupdating prevented
from
happening....? I thought DoEvents may have helped with this, but it
doesn't!

Should work. Make sure the order of operations is something like

Sub tester()
Application.Cursor = xlWait
Application.ScreenUpdating = False
'formatting here
DoEvents
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub

HTH. Best wishes Harald

No luck Harald

I now have a more important issue though regarding same workbook and a
similar problem but in Excel 97.

Excel 97 won't apply the formatting to the labels either way it seems. The
label show the font of Wingdings, but it won't display the caption that I
programmatically added in the Wingdings font. The properties dialogue shows
the caption as what it should be (chr 254) and the font face what it should
be (Wingdings) however the label is actually showing the caption as an Arial
chr(254) i.e. as if I added the caption as an Arial chr(254) even though the
font for the label is set to Wingdings. It's like I need to be able to
specify that the caption I'm adding should be in the Wingdings font.

I tried setting the label's locked value to false before setting the label
and caption but to no avail
Any suggestions?
Thanks
Matt


"Harald Staff" wrote in message
...
"Matt Jensen" skrev i melding
...
I've fixed that and now it seems to be all good! Hooray!! Seems strange
though...

Well spotted, well done.

One problem that remains though (and is somewhat different from this
problem
but still relevant to it) is that, even though at the start of the proc
I
have Application.Screenupdating = False & (pseudo code) cursor=hourglass
and
set it back to true and xldefault at the end of the proc respectively,
setting the *caption* of the label occurs after (it appears) that the
proc
has finished (cursor goes back to default AND is visible onscreen),
which
is
not good at all and what I would have thought screenupdating prevented
from
happening....? I thought DoEvents may have helped with this, but it
doesn't!

Should work. Make sure the order of operations is something like

Sub tester()
Application.Cursor = xlWait
Application.ScreenUpdating = False
'formatting here
DoEvents
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub

HTH. Best wishes Harald

You still around mate?
Thanks
Matt

"Matt Jensen" wrote in message
...
No luck Harald

I now have a more important issue though regarding same workbook and a
similar problem but in Excel 97.

Excel 97 won't apply the formatting to the labels either way it seems. The
label show the font of Wingdings, but it won't display the caption that I
programmatically added in the Wingdings font. The properties dialogue
shows
the caption as what it should be (chr 254) and the font face what it
should
be (Wingdings) however the label is actually showing the caption as an
Arial
chr(254) i.e. as if I added the caption as an Arial chr(254) even though
the
font for the label is set to Wingdings. It's like I need to be able to
specify that the caption I'm adding should be in the Wingdings font.

I tried setting the label's locked value to false before setting the label
and caption but to no avail
Any suggestions?
Thanks
Matt


"Harald Staff" wrote in message
...
"Matt Jensen" skrev i melding
...
I've fixed that and now it seems to be all good! Hooray!! Seems
strange
though...

Well spotted, well done.

One problem that remains though (and is somewhat different from this
problem
but still relevant to it) is that, even though at the start of the
proc
I
have Application.Screenupdating = False & (pseudo code)
cursor=hourglass
and
set it back to true and xldefault at the end of the proc respectively,
setting the *caption* of the label occurs after (it appears) that the
proc
has finished (cursor goes back to default AND is visible onscreen),
which
is
not good at all and what I would have thought screenupdating prevented
from
happening....? I thought DoEvents may have helped with this, but it
doesn't!

Should work. Make sure the order of operations is something like

Sub tester()
Application.Cursor = xlWait
Application.ScreenUpdating = False
'formatting here
DoEvents
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub

HTH. Best wishes Harald

You still around mate?

Around the world. Allow some slack for timezones my friend.

Zip the file and send it to hstf at hotmail dotcom and I'll try to look at
it.

Harald

No worries - thanks Harald!
Cheers
Matt

"Harald Staff" wrote in message
...
You still around mate?

Around the world. Allow some slack for timezones my friend.

Zip the file and send it to hstf at hotmail dotcom and I'll try to look at
it.

Harald

File bounced Harald because of size...
Matt

"Matt Jensen" wrote in message
...
No worries - thanks Harald!
Cheers
Matt

"Harald Staff" wrote in message
...
You still around mate?

Around the world. Allow some slack for timezones my friend.

Zip the file and send it to hstf at hotmail dotcom and I'll try to look
at
it.

Harald

Sorry to hear that. We're out of luck then, at least as a team.

Best wishes Harald

"Matt Jensen" skrev i melding
...
File bounced Harald because of size...
Matt

This is the code
This problem is becoming urgent as I have an imminent deadlien - I didn't
think it would be hard to solve but since it's not happening it's now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function checks if an OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the "working cell" when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call above)
Application.DisplayStatusBar = True 'make statusbar is visible if not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier & faster than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this array/range will be
used to determine what sort of checkboxes to show based on this project's
minimum PM Product Set
vaProductLevel = Worksheets("Data-PMProducts-MinimumSets"). _
Range("apprange_PMProducts_Level").Value 'this array/range is used
to determine what type of product the text we are working with is eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's Minimum PM Product
set range (which is dyanmically determined based on user's lifecycle and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first dimension of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the second
dimension of the array
'so we are effectively looping first thru rows and then thru each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts") _
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have a required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label object with a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j) Then 'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable checkboxes in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) + intSpacing *
(j) 'use set spacing variables
Set lbl = ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each check box stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle = fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name the label with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then 'display a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j) Then 'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j) Then 'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) + intSpacing *
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the checkbox with
it's row and column number

.Placement = xlMove ' This lets each check box stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle = fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there is no object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar back to the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a team.

Best wishes Harald

"Matt Jensen" skrev i melding
...
File bounced Harald because of size...
Matt

Hi Matt,

I haven't looked at your code but did you say earlier in the thread the
problem only relates to XL97. If so I think controls toolbox objects can
only be programatically changed whilst in Design mode. It's possible to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in message
...
This is the code
This problem is becoming urgent as I have an imminent deadlien - I didn't
think it would be hard to solve but since it's not happening it's now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function checks if an OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the "working cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call above)
Application.DisplayStatusBar = True 'make statusbar is visible if not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier & faster than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this array/range will be
used to determine what sort of checkboxes to show based on this project's
minimum PM Product Set
vaProductLevel = Worksheets("Data-PMProducts-MinimumSets"). _
Range("apprange_PMProducts_Level").Value 'this array/range is used
to determine what type of product the text we are working with is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's Minimum PM
Product
set range (which is dyanmically determined based on user's lifecycle and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first dimension of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the second
dimension of the array
'so we are effectively looping first thru rows and then thru each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts") _
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have a required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label object with a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j) Then 'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable checkboxes in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) + intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each check box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle = fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name the label with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then 'display a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j) Then 'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j) Then 'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) + intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the checkbox
with
it's row and column number

.Placement = xlMove ' This lets each check box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle = fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there is no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar back to the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a team.

Best wishes Harald

"Matt Jensen" skrev i melding
...
File bounced Harald because of size...
Matt

Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the thread the
problem only relates to XL97. If so I think controls toolbox objects can
only be programatically changed whilst in Design mode. It's possible to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in message
...
This is the code
This problem is becoming urgent as I have an imminent deadlien - I
didn't
think it would be hard to solve but since it's not happening it's now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function checks if an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the "working cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call above)
Application.DisplayStatusBar = True 'make statusbar is visible if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier & faster than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this array/range will
be
used to determine what sort of checkboxes to show based on this
project's
minimum PM Product Set
vaProductLevel = Worksheets("Data-PMProducts-MinimumSets"). _
Range("apprange_PMProducts_Level").Value 'this array/range is
used
to determine what type of product the text we are working with is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's Minimum PM
Product
set range (which is dyanmically determined based on user's lifecycle and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the second
dimension of the array
'so we are effectively looping first thru rows and then thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts") _
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have a required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label object with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j) Then 'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each check box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle = fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name the label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then 'display a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j) Then 'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j) Then 'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the checkbox
with
it's row and column number

.Placement = xlMove ' This lets each check box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle = fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there is no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar back to the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a team.

Best wishes Harald

"Matt Jensen" skrev i melding
...
File bounced Harald because of size...
Matt

I mainly work with xl97 but don't have access to my library of snippets at
the moment. I'm struggling with following, can't recall how I did it
before. Problem is exiting design mode, an error occurs trying to reference
the design mode icon which then causes an exit anyway.

First try your code starting in Design mode. If try variations of the
following - I know it looks extremely convoluted! As written it's neither
elegant nor reliable!!

Function Dmode(bMode As Boolean)

On Error Resume Next
'if in design mode following may error, if so the error alone may trigger
exit of design mode, handler?
If Application.CommandBars("Control Toolbox").Controls("Design Mode").State
= msoButtonUp Then
If bMode Then
Application.CommandBars("Control Toolbox").Controls("Design
Mode").Execute
End If
ElseIf Application.CommandBars("Control Toolbox").Controls("Design
Mode").State = msoButtonDown Then
If bMode = False Then Application.CommandBars("Control
Toolbox").Controls("Design Mode").Execute
End If

End Function

Regards,
Peter T

PS Whilst I remember, in XL97 set "takefocusonclick" to false, route of
several problems though not what you're doing at the moment.

"Matt Jensen" wrote in message
...
Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the thread the
problem only relates to XL97. If so I think controls toolbox objects can
only be programatically changed whilst in Design mode. It's possible to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in message
...
This is the code
This problem is becoming urgent as I have an imminent deadlien - I
didn't
think it would be hard to solve but since it's not happening it's now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function checks if an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the "working cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call above)
Application.DisplayStatusBar = True 'make statusbar is visible if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier & faster
than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this array/range
will
be
used to determine what sort of checkboxes to show based on this
project's
minimum PM Product Set
vaProductLevel = Worksheets("Data-PMProducts-MinimumSets"). _
Range("apprange_PMProducts_Level").Value 'this array/range is
used
to determine what type of product the text we are working with is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's Minimum PM
Product
set range (which is dyanmically determined based on user's lifecycle
and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first
dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the second
dimension of the array
'so we are effectively looping first thru rows and then thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts") _
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have a
required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label object
with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j) Then
'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each check box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle = fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name the label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then 'display a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j) Then
'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j) Then
'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the
checkbox
with
it's row and column number

.Placement = xlMove ' This lets each check box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle = fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there is no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar back to
the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a team.

Best wishes Harald

"Matt Jensen" skrev i melding
...
File bounced Harald because of size...
Matt

Re design mode etc,

Hope I've not sent you on a wild goose chase! There does appear to be a
particular problem changing font to a picture type in xl97.

Regards,
Peter

"Peter T" <peter_t@discussions wrote in message
...
I mainly work with xl97 but don't have access to my library of snippets at
the moment. I'm struggling with following, can't recall how I did it
before. Problem is exiting design mode, an error occurs trying to
reference
the design mode icon which then causes an exit anyway.

First try your code starting in Design mode. If try variations of the
following - I know it looks extremely convoluted! As written it's neither
elegant nor reliable!!

Function Dmode(bMode As Boolean)

On Error Resume Next
'if in design mode following may error, if so the error alone may trigger
exit of design mode, handler?
If Application.CommandBars("Control Toolbox").Controls("Design
Mode").State
= msoButtonUp Then
If bMode Then
Application.CommandBars("Control Toolbox").Controls("Design
Mode").Execute
End If
ElseIf Application.CommandBars("Control Toolbox").Controls("Design
Mode").State = msoButtonDown Then
If bMode = False Then Application.CommandBars("Control
Toolbox").Controls("Design Mode").Execute
End If

End Function

Regards,
Peter T

PS Whilst I remember, in XL97 set "takefocusonclick" to false, route of
several problems though not what you're doing at the moment.

"Matt Jensen" wrote in message
...
Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the thread
the
problem only relates to XL97. If so I think controls toolbox objects
can
only be programatically changed whilst in Design mode. It's possible
to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in message
...
This is the code
This problem is becoming urgent as I have an imminent deadlien - I
didn't
think it would be hard to solve but since it's not happening it's
now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function checks if
an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the "working
cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call above)
Application.DisplayStatusBar = True 'make statusbar is visible
if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier & faster
than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this array/range
will
be
used to determine what sort of checkboxes to show based on this
project's
minimum PM Product Set
vaProductLevel = Worksheets("Data-PMProducts-MinimumSets"). _
Range("apprange_PMProducts_Level").Value 'this array/range
is
used
to determine what type of product the text we are working with is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's Minimum PM
Product
set range (which is dyanmically determined based on user's lifecycle
and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first
dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the
second
dimension of the array
'so we are effectively looping first thru rows and then thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts") _
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have a
required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label object
with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j) Then
'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable
checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each check
box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle = fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name the
label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then 'display
a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j) Then
'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j) Then
'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the
checkbox
with
it's row and column number

.Placement = xlMove ' This lets each check
box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle = fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there is no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar back to
the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a team.

Best wishes Harald

"Matt Jensen" skrev i melding
...
File bounced Harald because of size...
Matt

No worries mate.
But a bit of a concern though, this problem! Maybe using the drawing element
text box instead would work...?
Matt

"Peter T" <peter_t@discussions wrote in message
...
Re design mode etc,

Hope I've not sent you on a wild goose chase! There does appear to be a
particular problem changing font to a picture type in xl97.

Regards,
Peter

"Peter T" <peter_t@discussions wrote in message
...
I mainly work with xl97 but don't have access to my library of snippets
at
the moment. I'm struggling with following, can't recall how I did it
before. Problem is exiting design mode, an error occurs trying to
reference
the design mode icon which then causes an exit anyway.

First try your code starting in Design mode. If try variations of the
following - I know it looks extremely convoluted! As written it's
neither
elegant nor reliable!!

Function Dmode(bMode As Boolean)

On Error Resume Next
'if in design mode following may error, if so the error alone may
trigger
exit of design mode, handler?
If Application.CommandBars("Control Toolbox").Controls("Design
Mode").State
= msoButtonUp Then
If bMode Then
Application.CommandBars("Control Toolbox").Controls("Design
Mode").Execute
End If
ElseIf Application.CommandBars("Control Toolbox").Controls("Design
Mode").State = msoButtonDown Then
If bMode = False Then Application.CommandBars("Control
Toolbox").Controls("Design Mode").Execute
End If

End Function

Regards,
Peter T

PS Whilst I remember, in XL97 set "takefocusonclick" to false, route of
several problems though not what you're doing at the moment.

"Matt Jensen" wrote in message
...
Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the thread
the
problem only relates to XL97. If so I think controls toolbox objects
can
only be programatically changed whilst in Design mode. It's possible
to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in message
...
This is the code
This problem is becoming urgent as I have an imminent deadlien - I
didn't
think it would be hard to solve but since it's not happening it's
now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function checks if
an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the "working
cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call above)
Application.DisplayStatusBar = True 'make statusbar is visible
if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier & faster
than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this array/range
will
be
used to determine what sort of checkboxes to show based on this
project's
minimum PM Product Set
vaProductLevel = Worksheets("Data-PMProducts-MinimumSets"). _
Range("apprange_PMProducts_Level").Value 'this array/range
is
used
to determine what type of product the text we are working with is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's Minimum
PM
Product
set range (which is dyanmically determined based on user's
lifecycle
and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first
dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the
second
dimension of the array
'so we are effectively looping first thru rows and then
thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts") _
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have a
required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label
object
with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j) Then
'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable
checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each check
box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle = fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name the
label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then
'display
a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j) Then
'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j) Then
'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the
checkbox
with
it's row and column number

.Placement = xlMove ' This lets each check
box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle = fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there is
no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or
false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar back
to
the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a team.

Best wishes Harald

"Matt Jensen" skrev i
melding
...
File bounced Harald because of size...
Matt

Maybe using the drawing element
text box instead would work...?

Yes I had the same thought - drawing textbox or rectangle & add text.
Pragmatic and simpler solution that should look the same. When done you
might want to protect - sheet - objects.

I had another attempt to programatically change font in a controls label to
Wingdings with all sorts of tricks, couldn't & miffed!

Regards,
Peter T


"Matt Jensen" wrote in message
...
No worries mate.
But a bit of a concern though, this problem! Maybe using the drawing
element
text box instead would work...?
Matt

"Peter T" <peter_t@discussions wrote in message
...
Re design mode etc,

Hope I've not sent you on a wild goose chase! There does appear to be a
particular problem changing font to a picture type in xl97.

Regards,
Peter

"Peter T" <peter_t@discussions wrote in message
...
I mainly work with xl97 but don't have access to my library of
snippets
at
the moment. I'm struggling with following, can't recall how I did it
before. Problem is exiting design mode, an error occurs trying to
reference
the design mode icon which then causes an exit anyway.

First try your code starting in Design mode. If try variations of the
following - I know it looks extremely convoluted! As written it's
neither
elegant nor reliable!!

Function Dmode(bMode As Boolean)

On Error Resume Next
'if in design mode following may error, if so the error alone may
trigger
exit of design mode, handler?
If Application.CommandBars("Control Toolbox").Controls("Design
Mode").State
= msoButtonUp Then
If bMode Then
Application.CommandBars("Control Toolbox").Controls("Design
Mode").Execute
End If
ElseIf Application.CommandBars("Control Toolbox").Controls("Design
Mode").State = msoButtonDown Then
If bMode = False Then Application.CommandBars("Control
Toolbox").Controls("Design Mode").Execute
End If

End Function

Regards,
Peter T

PS Whilst I remember, in XL97 set "takefocusonclick" to false, route
of
several problems though not what you're doing at the moment.

"Matt Jensen" wrote in message
...
Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the
thread
the
problem only relates to XL97. If so I think controls toolbox
objects
can
only be programatically changed whilst in Design mode. It's
possible
to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in
message
...
This is the code
This problem is becoming urgent as I have an imminent deadlien -
I
didn't
think it would be hard to solve but since it's not happening
it's
now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function checks
if
an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the "working
cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call above)
Application.DisplayStatusBar = True 'make statusbar is
visible
if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier &
faster
than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this
array/range
will
be
used to determine what sort of checkboxes to show based on this
project's
minimum PM Product Set
vaProductLevel = Worksheets("Data-PMProducts-MinimumSets").
_
Range("apprange_PMProducts_Level").Value 'this
array/range
is
used
to determine what type of product the text we are working with
is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's Minimum
PM
Product
set range (which is dyanmically determined based on user's
lifecycle
and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first
dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the
second
dimension of the array
'so we are effectively looping first thru rows and then
thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts") _
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have a
required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label
object
with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j)
Then
'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable
checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j)
Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle = fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name the
label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then
'display
a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j)
Then
'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there
is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j)
Then
'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" &
j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the
checkbox
with
it's row and column number

.Placement = xlMove ' This lets each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle = fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there
is
no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or
false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar
back
to
the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a
team.

Best wishes Harald

"Matt Jensen" skrev i
melding
...
File bounced Harald because of size...
Matt

Cool Peter

Just FYI, in xl97 I can programmatically change the font in a control label
to Wingdings, however when I specify the caption as Chr(252) it does not
take on the Wingdings font, it stays as Arial...
That being the problem.

I'm unsure if this comment
I had another attempt to programmatically change font in a controls label
to
Wingdings with all sorts of tricks, couldn't & miffed!
means that you can't do it at all or if you can't get the caption to take on
the font like I can't?

Matt


"Peter T" <peter_t@discussions wrote in message
...
Maybe using the drawing element
text box instead would work...?

Yes I had the same thought - drawing textbox or rectangle & add text.
Pragmatic and simpler solution that should look the same. When done you
might want to protect - sheet - objects.

I had another attempt to programatically change font in a controls label
to
Wingdings with all sorts of tricks, couldn't & miffed!

Regards,
Peter T


"Matt Jensen" wrote in message
...
No worries mate.
But a bit of a concern though, this problem! Maybe using the drawing
element
text box instead would work...?
Matt

"Peter T" <peter_t@discussions wrote in message
...
Re design mode etc,

Hope I've not sent you on a wild goose chase! There does appear to be
a
particular problem changing font to a picture type in xl97.

Regards,
Peter

"Peter T" <peter_t@discussions wrote in message
...
I mainly work with xl97 but don't have access to my library of
snippets
at
the moment. I'm struggling with following, can't recall how I did
it
before. Problem is exiting design mode, an error occurs trying to
reference
the design mode icon which then causes an exit anyway.

First try your code starting in Design mode. If try variations of
the
following - I know it looks extremely convoluted! As written it's
neither
elegant nor reliable!!

Function Dmode(bMode As Boolean)

On Error Resume Next
'if in design mode following may error, if so the error alone may
trigger
exit of design mode, handler?
If Application.CommandBars("Control Toolbox").Controls("Design
Mode").State
= msoButtonUp Then
If bMode Then
Application.CommandBars("Control Toolbox").Controls("Design
Mode").Execute
End If
ElseIf Application.CommandBars("Control Toolbox").Controls("Design
Mode").State = msoButtonDown Then
If bMode = False Then Application.CommandBars("Control
Toolbox").Controls("Design Mode").Execute
End If

End Function

Regards,
Peter T

PS Whilst I remember, in XL97 set "takefocusonclick" to false, route
of
several problems though not what you're doing at the moment.

"Matt Jensen" wrote in message
...
Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the
thread
the
problem only relates to XL97. If so I think controls toolbox
objects
can
only be programatically changed whilst in Design mode. It's
possible
to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in
message
...
This is the code
This problem is becoming urgent as I have an imminent
deadlien -
I
didn't
think it would be hard to solve but since it's not happening
it's
now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function
checks
if
an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the
"working
cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call
above)
Application.DisplayStatusBar = True 'make statusbar is
visible
if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier &
faster
than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets"). _
Range("projectrange_ProductSets").Value 'this
array/range
will
be
used to determine what sort of checkboxes to show based on
this
project's
minimum PM Product Set
vaProductLevel =
Worksheets("Data-PMProducts-MinimumSets").
_
Range("apprange_PMProducts_Level").Value 'this
array/range
is
used
to determine what type of product the text we are working with
is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's
Minimum
PM
Product
set range (which is dyanmically determined based on user's
lifecycle
and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the first
dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate product

For j = 1 To UBound(vaProducts, 2) 'columns are in the
second
dimension of the array
'so we are effectively looping first thru rows and
then
thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =
Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts")
_
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we have
a
required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label
object
with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" & j)
Then
'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable
checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j)
Then
ws.OLEObjects("cb_r" & i & "c" &
j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle =
fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name
the
label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then
'display
a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j)
Then
'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely there
is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" & j)
Then
'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" &
j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing) +
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name the
checkbox
with
it's row and column number

.Placement = xlMove ' This lets each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle =
fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that there
is
no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j) Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j) Then
ws.OLEObjects("lbl_r" & i & "c" & j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true or
false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar
back
to
the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a
team.

Best wishes Harald

"Matt Jensen" skrev i
melding
...
File bounced Harald because of size...
Matt

Hmm - you can but I can't! I'll have to take a proper look at your code.

What happens for me is that the font name correctly changes to Wingdings,
but the symbols do not display. Instead, whatever chr codes remain displayed
as the default font (new Control label) or any other Latin font that I may
have set if changing an existing Label. Now if I click the 3 dots that
appear in properties, Wingdings is selected, OK out and now the font is
updated.

Another odd thing is I can apparently apply a non existant font name, say
"FontXYZ" without error. When done "FontXYZ" appears as the font name in
properties, but the displayed font remains as was.

No problem to correctly apply and update a regular font in code.

Regards,
Peter T

"Matt Jensen" wrote in message
...
Cool Peter

Just FYI, in xl97 I can programmatically change the font in a control
label
to Wingdings, however when I specify the caption as Chr(252) it does not
take on the Wingdings font, it stays as Arial...
That being the problem.

I'm unsure if this comment
I had another attempt to programmatically change font in a controls
label
to
Wingdings with all sorts of tricks, couldn't & miffed!
means that you can't do it at all or if you can't get the caption to take
on
the font like I can't?

Matt


"Peter T" <peter_t@discussions wrote in message
...
Maybe using the drawing element
text box instead would work...?

Yes I had the same thought - drawing textbox or rectangle & add text.
Pragmatic and simpler solution that should look the same. When done you
might want to protect - sheet - objects.

I had another attempt to programatically change font in a controls label
to
Wingdings with all sorts of tricks, couldn't & miffed!

Regards,
Peter T


"Matt Jensen" wrote in message
...
No worries mate.
But a bit of a concern though, this problem! Maybe using the drawing
element
text box instead would work...?
Matt

"Peter T" <peter_t@discussions wrote in message
...
Re design mode etc,

Hope I've not sent you on a wild goose chase! There does appear to
be
a
particular problem changing font to a picture type in xl97.

Regards,
Peter

"Peter T" <peter_t@discussions wrote in message
...
I mainly work with xl97 but don't have access to my library of
snippets
at
the moment. I'm struggling with following, can't recall how I did
it
before. Problem is exiting design mode, an error occurs trying to
reference
the design mode icon which then causes an exit anyway.

First try your code starting in Design mode. If try variations of
the
following - I know it looks extremely convoluted! As written it's
neither
elegant nor reliable!!

Function Dmode(bMode As Boolean)

On Error Resume Next
'if in design mode following may error, if so the error alone may
trigger
exit of design mode, handler?
If Application.CommandBars("Control Toolbox").Controls("Design
Mode").State
= msoButtonUp Then
If bMode Then
Application.CommandBars("Control
Toolbox").Controls("Design
Mode").Execute
End If
ElseIf Application.CommandBars("Control Toolbox").Controls("Design
Mode").State = msoButtonDown Then
If bMode = False Then Application.CommandBars("Control
Toolbox").Controls("Design Mode").Execute
End If

End Function

Regards,
Peter T

PS Whilst I remember, in XL97 set "takefocusonclick" to false,
route
of
several problems though not what you're doing at the moment.

"Matt Jensen" wrote in
message
...
Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the
thread
the
problem only relates to XL97. If so I think controls toolbox
objects
can
only be programatically changed whilst in Design mode. It's
possible
to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in
message
...
This is the code
This problem is becoming urgent as I have an imminent
deadlien -
I
didn't
think it would be hard to solve but since it's not happening
it's
now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function
checks
if
an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the
"working
cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call
above)
Application.DisplayStatusBar = True 'make statusbar is
visible
if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier &
faster
than
working with the named ranges directly
vaProducts = Worksheets("Data-PMProducts-MinimumSets").
_
Range("projectrange_ProductSets").Value 'this
array/range
will
be
used to determine what sort of checkboxes to show based on
this
project's
minimum PM Product Set
vaProductLevel =
Worksheets("Data-PMProducts-MinimumSets").
_
Range("apprange_PMProducts_Level").Value 'this
array/range
is
used
to determine what type of product the text we are working
with
is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's
Minimum
PM
Product
set range (which is dyanmically determined based on user's
lifecycle
and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the
first
dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate
product

For j = 1 To UBound(vaProducts, 2) 'columns are in
the
second
dimension of the array
'so we are effectively looping first thru rows and
then
thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =

Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts")
_
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we
have
a
required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE label
object
with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" &
j)
Then
'only
create checkbox if it doesn't alreay exist

'first delete any unrequired, clickable
checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" & j)
Then
ws.OLEObjects("cb_r" & i & "c" &
j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft - intSpacing)
+
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle =
fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j 'name
the
label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then
'display
a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" & j)
Then
'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely
there
is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" &
j)
Then
'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" &
j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft - intSpacing)
+
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name
the
checkbox
with
it's row and column number

.Placement = xlMove ' This lets each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle =
fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that
there
is
no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j)
Then
ws.OLEObjects("cb_r" & i & "c" & j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j)
Then
ws.OLEObjects("lbl_r" & i & "c" &
j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true
or
false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the statusbar
back
to
the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as a
team.

Best wishes Harald

"Matt Jensen" skrev i
melding
...
File bounced Harald because of size...
Matt

Peter
We're getting our wires crossed.
The same thing happens for me as what you just said.
I've changed to drawing textboxes and all works fine now! Hooray!!!
Happy New Year!
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hmm - you can but I can't! I'll have to take a proper look at your code.

What happens for me is that the font name correctly changes to Wingdings,
but the symbols do not display. Instead, whatever chr codes remain
displayed
as the default font (new Control label) or any other Latin font that I may
have set if changing an existing Label. Now if I click the 3 dots that
appear in properties, Wingdings is selected, OK out and now the font is
updated.

Another odd thing is I can apparently apply a non existant font name, say
"FontXYZ" without error. When done "FontXYZ" appears as the font name in
properties, but the displayed font remains as was.

No problem to correctly apply and update a regular font in code.

Regards,
Peter T

"Matt Jensen" wrote in message
...
Cool Peter

Just FYI, in xl97 I can programmatically change the font in a control
label
to Wingdings, however when I specify the caption as Chr(252) it does not
take on the Wingdings font, it stays as Arial...
That being the problem.

I'm unsure if this comment
I had another attempt to programmatically change font in a controls
label
to
Wingdings with all sorts of tricks, couldn't & miffed!
means that you can't do it at all or if you can't get the caption to
take
on
the font like I can't?

Matt


"Peter T" <peter_t@discussions wrote in message
...
Maybe using the drawing element
text box instead would work...?

Yes I had the same thought - drawing textbox or rectangle & add text.
Pragmatic and simpler solution that should look the same. When done
you
might want to protect - sheet - objects.

I had another attempt to programatically change font in a controls
label
to
Wingdings with all sorts of tricks, couldn't & miffed!

Regards,
Peter T


"Matt Jensen" wrote in message
...
No worries mate.
But a bit of a concern though, this problem! Maybe using the drawing
element
text box instead would work...?
Matt

"Peter T" <peter_t@discussions wrote in message
...
Re design mode etc,

Hope I've not sent you on a wild goose chase! There does appear to
be
a
particular problem changing font to a picture type in xl97.

Regards,
Peter

"Peter T" <peter_t@discussions wrote in message
...
I mainly work with xl97 but don't have access to my library of
snippets
at
the moment. I'm struggling with following, can't recall how I
did
it
before. Problem is exiting design mode, an error occurs trying
to
reference
the design mode icon which then causes an exit anyway.

First try your code starting in Design mode. If try variations
of
the
following - I know it looks extremely convoluted! As written
it's
neither
elegant nor reliable!!

Function Dmode(bMode As Boolean)

On Error Resume Next
'if in design mode following may error, if so the error alone
may
trigger
exit of design mode, handler?
If Application.CommandBars("Control Toolbox").Controls("Design
Mode").State
= msoButtonUp Then
If bMode Then
Application.CommandBars("Control
Toolbox").Controls("Design
Mode").Execute
End If
ElseIf Application.CommandBars("Control
Toolbox").Controls("Design
Mode").State = msoButtonDown Then
If bMode = False Then Application.CommandBars("Control
Toolbox").Controls("Design Mode").Execute
End If

End Function

Regards,
Peter T

PS Whilst I remember, in XL97 set "takefocusonclick" to false,
route
of
several problems though not what you're doing at the moment.

"Matt Jensen" wrote in
message
...
Interesting Peter - this could be a winner!
Can you point me to any more specific info...?
Thanks
Matt

"Peter T" <peter_t@discussions wrote in message
...
Hi Matt,

I haven't looked at your code but did you say earlier in the
thread
the
problem only relates to XL97. If so I think controls toolbox
objects
can
only be programatically changed whilst in Design mode. It's
possible
to
toggle or "Execute" the design mode icon to change "State".

Regards,
Peter T


"Matt Jensen" wrote in
message
...
This is the code
This problem is becoming urgent as I have an imminent
deadlien -
I
didn't
think it would be hard to solve but since it's not
happening
it's
now
becoming urgent.
Any help greatly appreciated!
Matt

Option Explicit

Function OLEObjectExists(sName As String) 'this function
checks
if
an
OLE
object name exists
Dim vtop
On Error Resume Next
vtop = ActiveSheet.OLEObjects(sName).top
If Err = 0 Then
OLEObjectExists = True
Else
OLEObjectExists = False
Err.Clear
End If
End Function

Sub PopulateA10PMProductRange()
Application.ScreenUpdating = False
Application.Cursor = xlWait

'dimension variables
Dim vaProducts, vaProductLevel As Variant 'create
arrays
Dim i, j As Integer 'i for row, j for column
Dim cellUnder As Range 'this variables contains the
"working
cell"
when
creating the checkboxes
Dim cb, lbl As OLEObject
Dim ws As Worksheet
Dim MyChar
Dim intLeft, intSpacing, intLeftLocation As Integer

'assign values to variables
Set ws = Worksheets("A10Checklist")
ws.Range("A1").Activate
MyChar = Chr(252)
intLeft = 280
intSpacing = 50

'status bar message (must come after 'activate' call
above)
Application.DisplayStatusBar = True 'make statusbar is
visible
if
not
already
'set status bar message
Application.StatusBar = "Updating gate products..."

'assign the values of named ranges to arrays - easier
&
faster
than
working with the named ranges directly
vaProducts =
Worksheets("Data-PMProducts-MinimumSets").
_
Range("projectrange_ProductSets").Value 'this
array/range
will
be
used to determine what sort of checkboxes to show based on
this
project's
minimum PM Product Set
vaProductLevel =
Worksheets("Data-PMProducts-MinimumSets").
_
Range("apprange_PMProducts_Level").Value 'this
array/range
is
used
to determine what type of product the text we are working
with
is
eg.0=gate
names,1=heading,2=product,3=working product

'loop thru vaProducts array i.e. loop thru project's
Minimum
PM
Product
set range (which is dyanmically determined based on user's
lifecycle
and
category selection)
For i = 1 To UBound(vaProducts, 1) 'rows are in the
first
dimension
of
the array

'only display gate products
If vaProductLevel(i, 1) = 2 Then 'we have a gate
product

For j = 1 To UBound(vaProducts, 2) 'columns are in
the
second
dimension of the array
'so we are effectively looping first thru rows and
then
thru
each
row's column (if it is a gate product)

'locate the actual cell where we need to 'work'
Set cellUnder =

Worksheets("A10Checklist").Range("anchorpoint_A10P MProducts")
_
.Offset(i - 1, j + 1)

If UCase(vaProducts(i, j)) = "TRUE" Then 'we
have
a
required
gate product so display a non-clickable checkbox

'create an unclickable checkbox (an OLE
label
object
with
a
Wingdings checkbox character as it's caption)
If Not OLEObjectExists("lbl_r" & i & "c" &
j)
Then
'only
create checkbox if it doesn't alreay exist

'first delete any unrequired,
clickable
checkboxes
in
this matrix location
If OLEObjectExists("cb_r" & i & "c" &
j)
Then
ws.OLEObjects("cb_r" & i & "c" &
j).Delete
End If

'set properties of new label-checkbox
intLeftLocation = (intLeft -
intSpacing)
+
intSpacing
*
(j) 'use set spacing variables
Set lbl =
ws.OLEObjects.Add(ClassType:="Forms.Label.1",
_
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With lbl
.Placement = xlMove ' This lets
each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.Caption = MyChar
'.BackColor = &H80000005
'.BackStyle =
fmBackStyleTransparent
'.Font.Size = "12"
'.ForeColor = &HFF&
.Font.Name = "Wingdings"
'.Name = "lbl_r" & i & "c" & j
'DoEvents
'.Font.Bold = True
End With
.Name = "lbl_r" & i & "c" & j
'name
the
label
with
it's array row and column number
End With
End If

ElseIf UCase(vaProducts(i, j)) = "FALSE" Then
'display
a
clickable checkbox.

'create clickable checkbox
If Not OLEObjectExists("cb_r" & i & "c" &
j)
Then
'only
create checkbox if it doesn't alreay exist

'if there is no checkbox it's likely
there
is
label-checkbox so delete it first
If OLEObjectExists("lbl_r" & i & "c" &
j)
Then
'only
delete label-checkbox if it exists
ws.OLEObjects("lbl_r" & i & "c" &
j).Delete
End If

'create properties of checkbox
intLeftLocation = (intLeft -
intSpacing)
+
intSpacing
*
(j)
'set properties of checkbox
Set cb =
ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=intLeftLocation, _
top:=cellUnder.top + 4, _
Width:="10.5", _
Height:="10.5", _
DisplayAsIcon:=False)
With cb 'add other info
.Name = "cb_r" & i & "c" & j 'name
the
checkbox
with
it's row and column number

.Placement = xlMove ' This lets
each
check
box
stay
with its row during sorts. NEEDED???
With .Object
.BackColor = &H80000005
.BackStyle =
fmBackStyleTransparent
.Caption = ""
End With
End With
End If
Else 'it's not True or False so enforce that
there
is
no
object
there by deleting any
If OLEObjectExists("cb_r" & i & "c" & j)
Then
ws.OLEObjects("cb_r" & i & "c" &
j).Delete
End If
If OLEObjectExists("lbl_r" & i & "c" & j)
Then
ws.OLEObjects("lbl_r" & i & "c" &
j).Delete
End If
End If ' end if of "if vaProducts(i, j) = true
or
false"
statement
Next j
End If
Next i

DoEvents
Application.ScreenUpdating = True
Application.StatusBar = False 'give control of the
statusbar
back
to
the
programme
Application.Cursor = xlDefault
End Sub


"Harald Staff" wrote in message
...
Sorry to hear that. We're out of luck then, at least as
a
team.

Best wishes Harald

"Matt Jensen" skrev
i
melding
...
File bounced Harald because of size...
Matt

I'll give a big capital "D" in a wingdings font for all this.

A Happy New Year to you too Matt and good luck with your project.

Peter

"Matt Jensen" wrote in message
...
Peter
We're getting our wires crossed.
The same thing happens for me as what you just said.
I've changed to drawing textboxes and all works fine now! Hooray!!!
Happy New Year!
Matt

snip <