PDA

View Full Version : [SOLVED] Format all my Command Buttons The Same - Retain Press Color Change Individual Button



dj44
02-23-2016, 11:25 AM
Hi Folks,:)

in my excel I have 10 command buttons.


Now each button is set up like this

15456





Private Sub CommandButton1_Click()

With CommandButton1

If .BackColor = 9109504 Then
.BackColor = vbRed
.Caption = " Do Task"
Else
.BackColor = 9109504
.Caption = "Completed"
End If
End With

End Sub


Private Sub CommandButton2_Click()

With CommandButton2

If .BackColor = 9109504 Then
.BackColor = vbRed
.Caption = " Do Task"
Else
.BackColor = 9109504
.Caption = "Completed"
End If
End With

End Sub




The code is very repetitive, I have to scroll all the way down to command button 20 in other workbooks.

How can I have all of the command buttons have the same properties.

I still want the color to change when I press each button individually - So I can keep track of what I am doing.

is this too hard to do - i have been all over and I don't how to solve this

thanks folks:thumb

DJ

SamT
02-23-2016, 04:03 PM
CommandButton1_Click
'Not real Code
ResetAllButtons
SetMeCompleted CommandButton1
End Sub


Sub ResetAllButtons
'Not real code
For Each CBut in Controls
With CBut
.BackColor = vbRed
.Caption = " Do Task"
End With
Next CBut
End sUb

Sub setMeCompleted(CbutName As String)
'Not real code
With Controls(CbutName)
.BackColor = 9109504
.Caption = "Completed"
End With
End Sub

Copy Sub Commandbutton1 ten times , change 2 numbers nine times. Add additional code to each as needed

dj44
02-23-2016, 06:00 PM
Hello Sam,

thank you for helping to do this job.

I put the good code into a sheet :grinhalo:

but this error popped up

15460

it highlighted the commandbutton1

setMeCompleted CommandButton1

When I pressed the button 2



Private Sub CommandButton2_Click()

MsgBox "hello"

End Sub


The color did not change with new caption saying "Completed"

I wonder if I am setting it up correctly

my gratitude for this help :)

DJ

Paul_Hossler
02-23-2016, 07:50 PM
I think SamT meant to pass it as a string, and not the control object

Try it with " " around the CB's Name





CommandButton1_Click
'Not real Code
ResetAllButtons
SetMeCompleted "CommandButton1"
End Sub

Paul_Hossler
02-23-2016, 08:15 PM
Another way that doesn't have any code in the ActiveX, but puts it into a Class With Events instead

1. In ThisWorkbook



Option Explicit
'http://www.mrexcel.com/forum/excel-questions/189655-me-activecontrol-worksheet-not-userform.html
Private Sub Workbook_Open()
LoadCommandButtons
End Sub




2. In a Standard Module



Option Explicit
Dim cmdButtonHandler() As New clsCommandButton
Sub LoadCommandButtons()
Dim cmdButtonQuantity As Long
Dim MYcmdButton As OLEObject
Dim ws As Worksheet
cmdButtonQuantity = 0

For Each ws In ThisWorkbook.Worksheets
For Each MYcmdButton In ws.OLEObjects
If TypeName(MYcmdButton.Object) = "CommandButton" Then
cmdButtonQuantity = cmdButtonQuantity + 1
ReDim Preserve cmdButtonHandler(1 To cmdButtonQuantity)
Set cmdButtonHandler(cmdButtonQuantity).cmdButtonGroup = MYcmdButton.Object
End If
Next MYcmdButton
Next
End Sub




3. In a class module call clsCommandButton



Option Explicit
Public WithEvents cmdButtonGroup As CommandButton
Private Sub cmdButtonGroup_Click()
With cmdButtonGroup

If .BackColor = 9109504 Then
.BackColor = vbRed
.Caption = " Do Task"
Else
.BackColor = 9109504
.Caption = "Completed"
End If
End With
End Sub





You'll still need to polish it a bit, and I struggle with some of it (Graduate level material as far as I'm concerned), but there's plenty of references and explainations on the web about the technique. I thought there was one or two here in the forums. but I didn't find them

dj44
02-23-2016, 08:54 PM
Hello Paul,

thanks for being a super champ. :hifive:

It's very magnanimous gesture to put in a book for me as well. chuffed as a chip I am


I've been up and down for past 2 days. these buttons are not innocent i say - first I couldn't get the colors changed, then the Excel wouldn't let me select the buttons.

Now those buttons have no chance of escaping with this great code. My eyes thank you for reducing the code i had to scroll through - got 30 + buttons

I will get them ship shape in order and report back on progress on my book.:type

thanks to Sam as well

thank you Paul for helping :grinhalo:

Dj

Jan Karel Pieterse
02-24-2016, 01:38 AM
This all would've been easier with form buttons, albeit that those have a fixed backcolor. You can change their font color though.
Place Form buttons on the sheet. Assign them to the macro "ColorButton" and place this code in a normal module:


Sub ColorButton()
Dim oBtn As Button
ResetAll
Set oBtn = ActiveSheet.Buttons(Application.Caller)
oBtn.Font.Color = 9109504
End Sub
Sub ResetAll()
Dim oBtn As Button
For Each oBtn In ActiveSheet.Buttons
oBtn.Font.Color = vbRed
Next
End Sub

snb
02-24-2016, 06:33 AM
Paul's suggestion simplified:

Jan Karel Pieterse
02-24-2016, 07:52 AM
Not bad snb. Minor quibble: you declare sp as an array and assume it is one-based, but arrays are by default zero-based.

SamT
02-24-2016, 08:10 AM
I think SamT meant to pass it as a string, and not the control object

Try it with " " around the CB's Name





CommandButton1_Click
'Not real Code
ResetAllButtons
SetMeCompleted "CommandButton1"
End Sub


The clues were
'Not real code
And
(CButName As String)

dj44
02-24-2016, 09:29 AM
Folks ,


thank you very much for all the generous help. I am very humbled.:)

I had a final question.


Am I able to do this:

I am adapting Paul's code found in clsCommandButton - class Module

I am trying to cut down the code just a little bit more




Option Explicit

Public WithEvents cmdButtonGroup As CommandButton

Private Sub cmdButtonGroup_Click()
With cmdButtonGroup

If .BackColor = 9109504 Then
.BackColor = vbRed
.Caption = " Do Task"
Else
.BackColor = 9109504
.Caption = "Completed"
End If
End With

================= This code below is normally in each command button - i moved it here?

Dim WordApp As Object

On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
On Error GoTo 0

If WordApp Is Nothing Then
Set WordApp = CreateObject("Word.Application")
End If
WordApp.Visible = False
WordApp.Documents.Open "C:\Users\DJ-PC\Desktop\DJMacros.docm"



WordApp.Run " macro1" '<< Commandbutton1 pressed

'WordApp.Run " macro2" ' << CommandButton2 pressed

'WordApp.Run " macro3" ' << CommandButton3 pressed

.....etc

End Sub




These buttons are in the Worksheet :




Private Sub CommandButton1_Click()

WordApp.Run " macro1" ' Can I do this?

End Sub


Private Sub CommandButton2_Click()

WordApp.Run " macro2"

End Sub

Private Sub CommandButton3_Click()

WordApp.Run " macro3"

End Sub




oh code woes - you folks help me to cut down on repetitive code and now i get some more:devil2:. Not today I say.

Gentlemen what do you think

thank you so much

DJ

mikerickson
02-24-2016, 10:04 AM
This all would've been easier with form buttons, albeit that those have a fixed backcolor. You can change their font color though.
Place Form buttons on the sheet. Assign them to the macro "ColorButton" and place this code in a normal module:


Or you could use Rounded Rectangles or any other shape and assign that macro to them.

Paul_Hossler
02-24-2016, 10:05 AM
Probably the easiest way is to use the .Name of each button

I renamed CommandButton1 to give it a 'good' name ('macro1'), so that's the only one that works.

You could call the Word macros CommandButton1, etc. or a Select Case in the class to 'translate' the CommandButtonX .Name to a macro



Slight mod to the clsCommandButton class




Option Explicit
Public WithEvents cmdButtonGroup As CommandButton
Private Sub cmdButtonGroup_Click()
With cmdButtonGroup

If .BackColor = 9109504 Then
.BackColor = vbRed
.Caption = " Do Task"
Else
.BackColor = 9109504
.Caption = "Completed"
End If
End With

Dim WordApp As Object

On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
On Error GoTo 0

If WordApp Is Nothing Then
Set WordApp = CreateObject("Word.Application")
End If

WordApp.Visible = False

' WordApp.Documents.Open "C:\Users\DJ-PC\Desktop\DJMacros.docm"
WordApp.Documents.Open Environ("USERPROFILE") & "\Desktop\doc1.docm"

WordApp.Run cmdButtonGroup.Name
WordApp.Quit
End Sub

dj44
02-24-2016, 12:21 PM
Paul,

thank you for going the extra mile to help me.



I renamed CommandButton1 to give it a 'good' name ('macro1'), so that's the only one that works.

I did that :checkmark

it nicely run the macro from the word document. So I know it works.

But now the trail has gone quiet ....

I dunno what I've done wrong :( I have not changed anything.

I feel really dim witted, is it meant to be this hard to get some buttons working - with all the help from you good folk.

I will persevere, nearly there, just need to get the other buttons calling the macros stored in the document to run.


Select Case in the class to 'translate' the CommandButtonX .Name to a macro

I need to do something to that.

You see folks - I'm not trying to be difficult - command buttons, shapes or rectangles I never minded, so long as they get the job done -



Press the button run the code
Change Color of button - to keep track


but the code I have found were to do with command buttons - so i thought i would use those, and they help me to keep track of which macros have been run, when the color changes.

let me persevere its good practice for the old newbie apprentice:old:

cheers folks

dj

dj44
02-24-2016, 12:57 PM
Folks,

I have managed to get another button working.....


:grinhalo:


I think I have isolated the problem - I need to reset the buttons back to original color - so it refreshes.


Then I can press it to run the macro again


Let me test more

dj44
02-24-2016, 01:39 PM
Folks,

may I say a very big thank you to you fine gentlemen coders for your input.:grinhalo:


I am very pleased and happy to say with the help from you good folk I can now sort out my excel dashboard :type.

Its got 5 worksheets and growing and 10 buttons per worksheet to gear up now - but I'm sure I can do this now.

Paul you have been such a great man for doing those workbooks for me to test, and for those codes.

I will use the other code -too once i have a chance to understand everything properly - the ins and outs of class buttons and its ilke


You folks have a great Wednesday.

thanks very much again - buddy cheers to all :beerchug:

DJ

snb
02-24-2016, 03:20 PM
Not bad snb. Minor quibble: you declare sp as an array and assume it is one-based, but arrays are by default zero-based.

You might know I never assume arrays to be 1-based.(http://www.snb-vba.eu/VBA_Arrays.html)
In this case the array is redimmed using .count on a 1-based count, so the array will always contain 1 item more then necessary to contain all the items that are being counted.
That gives the opportunity to assign the oleobjects to the array items index that corresponds to the oleobjects indexnumbers.
Resulting in an array in which the first item will remain 'empty'.
For this purpose it doesn't matter at all.
So your assumption on my assumption wasn't correct.

snb
02-24-2016, 03:40 PM
@dj44

It looks as if you overlooked the suggestion I posted; that only contains the following code:

Class (c_button) module:


Public WithEvents v_button As CommandButton

Private Sub v_button_Click()
With v_button
.BackColor = IIf(.BackColor = 9109504, vbRed, 9109504)
.Caption = IIf(.Caption = "Completed", " Do Task", "Completed")
End With
End Sub

Workbook module


Dim sp() As New c_button

Sub LoadCommandButtons()
With Sheet1
ReDim sp(.OLEObjects.Count)

For j = 1 To UBound(sp)
If TypeName(.OLEObjects(j).Object) = "CommandButton" Then Set sp(j).v_button = .OLEObjects(j).Object
Next
End With
End Sub

How simple/effective VBA code can be.....

SamT
02-24-2016, 05:17 PM
I had a final question.


Am I able to do this:

I am adapting Paul's code found in clsCommandButton - class Module

I am trying to cut down the code just a little bit more

In ThisWorkbook, Declare Public WordApp As New clsWordApp

Move the WordApp code in your post to the clsWordApp Class Module.

Change all instances of "WordApp" to "mWordApp" to differentiate them.

Add the Following Subs to clsWordApp

Public Sub Macro1()
mWordApp.Macro1
End Sub

Public Sub Macro2()
mWordApp.Macro2
End Sub


Private Sub CommandButton1_Click()

WordApp.Run " macro1" ' Can I do this?

End Sub

Private Sub CommandButton1_Click()
WordApp.Macro1 'Then you can do this
End Sub

dj44
02-24-2016, 05:43 PM
Thank you snb and SamT,

for the additional code.:grinhalo:

This has been a crash course in the command button class.

By the end of it I will be a pro.

I will use the added suggestions, it will take me time to set it all up, I am a bit slow as newbie

have a great evening

DJ

Paul_Hossler
02-25-2016, 08:24 AM
@DJ -- I don't know how complicated or duplicated the Word macros are, but there's ways to simplify the call, so if several buttons call the same Word macro, you can make the call a little smarter




Option Explicit
Public WithEvents cmdButtonGroup As CommandButton
Private Sub cmdButtonGroup_Click()
Dim sMacroName As String

With cmdButtonGroup

If .BackColor = vbGreen Then
.BackColor = vbRed
.Caption = "Do Task"
Else
.BackColor = vbGreen
.Caption = "Completed"
End If


If Left(.Name, Len(.Name) - 1) = "CommandButton" Then
sMacroName = "macro_CommandButton"

Else
Select Case .Name
Case "macro_1", "macro_2", "macro_3"
sMacroName = .Name
Case Else
sMacroName = "macro_other"
End Select
End If

End With

Dim WordApp As Object

On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
On Error GoTo 0


If WordApp Is Nothing Then
Set WordApp = CreateObject("Word.Application")
End If

WordApp.Visible = False

' WordApp.Documents.Open "C:\Users\DJ-PC\Desktop\DJMacros.docm"
WordApp.Documents.Open Environ("USERPROFILE") & "\Desktop\testing.docm"


WordApp.Run sMacroName
WordApp.Quit
End Sub







Option Explicit
Dim cmdButtonHandler() As New clsCommandButton
Sub LoadCommandButtons()
Dim cmdButtonQuantity As Long
Dim MYcmdButton As OLEObject
Dim ws As Worksheet
cmdButtonQuantity = 0

For Each ws In ThisWorkbook.Worksheets
For Each MYcmdButton In ws.OLEObjects
If TypeName(MYcmdButton.Object) = "CommandButton" Then
cmdButtonQuantity = cmdButtonQuantity + 1
ReDim Preserve cmdButtonHandler(1 To cmdButtonQuantity)
Set cmdButtonHandler(cmdButtonQuantity).cmdButtonGroup = MYcmdButton.Object
End If
Next MYcmdButton
Next
End Sub

Sub MarkAllToDo()
Dim iButton As Long

LoadCommandButtons

For iButton = LBound(cmdButtonHandler) To UBound(cmdButtonHandler)
cmdButtonHandler(iButton).cmdButtonGroup.BackColor = vbRed
cmdButtonHandler(iButton).cmdButtonGroup.Caption = "To Do"
Next iButton
End Sub

dj44
02-25-2016, 09:22 AM
Paul,

this is terrific work!

thank you again for lending your time and the books too.:friends:

This great work solves a lot of problems.

I will use this and tweak it for :

Command buttons in excel dashboard
To make my user form in excel - those will have lots of buttons on


I can also use and tweak it for word command buttons and the user form, as well as PPT.....and I am sure the other office apps may need a user form too in the future. The adage teach a man to fish - is true here.:type.

Nowadays everything is a bit more complicated - you need 5 different applications to get one job done.:stars:


So I got lots of great plans and uses for these command buttons.


I started this project months ago, and I looked on all the forums - I found how to change the color of the buttons, but all the rest didn't work or was outdated - gave me errors, i tried to do it from word, but then I had to switch to excel, so i thought I would stay in excel and call word.

It became complicated for me with my skills - because then switching form excel to do tasks in word was becoming really difficult - I had to hunt down the folders and macros - and it was a big mess, and that's another story altogether.

Well that's no more thanks to you good folks.

:grinhalo:thanks to all the fine gentlemen as well who gave code, you can never have too much code - I will use those too - i just have too many buttons to plan for now.

I will have the best kitted out dashboard - once Ive hooked up all my buttons and macros - it will work like a treat as it is now on these test buttons

buddy cheers to all and enjoy your day :biggrin:


DJ