PDA

View Full Version : [SOLVED] OLEObjects current selection - change color



vbxingsang86
06-28-2017, 08:48 AM
hey guys,
im kinda new to vba programming and i havent found a solution for my (hopefully not very special) problem. i cant get my macro working, which should change the backcolor of my selected label. i get this working for a special label but not on the selection case.

here is my code of the special ones working:


Dim sh As Worksheet
Set sh = Worksheets("AVD S1314")
sh.OLEObjects("Label1").Object.BackColor = vbRed

would be glad if u can help me

Many thanks in advance !

mana
06-29-2017, 03:58 AM
If TypeName(Selection) = "OLEObject" Then
If TypeName(Selection.Object) = "Label" Then
Selection.Object.BackColor = vbRed
End If
End If

vbxingsang86
07-07-2017, 12:49 AM
At first, thank you for your help,

This is not a solution and i think i wasnt that enough at my first post.

I want do this is as a label click event. so the process is like this: click on a label, an userforms opens and you can choose between two or three option buttons, one of these option buttons should turn the label in a red backcolor.

Thank You for your help so far!

mdmackillop
07-07-2017, 02:07 AM
This will set the label colour as the BackColor of the Option Buttons


Private Sub Label1_Click()
UserForm1.Show 0
End Sub


'On userform
Private Sub OptionButton1_Click()
LabelColour Me.ActiveControl.Name
End Sub


Private Sub OptionButton2_Click()
LabelColour Me.ActiveControl.Name
End Sub


Private Sub OptionButton3_Click()
LabelColour Me.ActiveControl.Name
End Sub


Sub LabelColour(cName)
ActiveSheet.OLEObjects("Label1").Object.BackColor = Me.Controls(cName).BackColor
Unload UserForm1
End Sub

vbxingsang86
07-12-2017, 07:24 AM
First of all thank you all guys, that you have tried to help me! Ive continued trying on my own and find another way to solve my problem. It looks like this:


Dim sh As Shape
Dim ws As Worksheet
Dim g As OLEObject
Dim lX As Long
With Sheets("AVD S1314")
For Each sh In .Shapes
If (Left(sh.Name, 5) = "Label") Then
Debug.Print sh.Name
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.InsertLines .CountOfLines + 1, "Public Sub " & sh.Name & "_Click()"
.InsertLines .CountOfLines + 2, "Load fertigungsstatus"
.InsertLines .CountOfLines + 3, "fertigungsstatus.var = """ & sh.Name & """"
.InsertLines .CountOfLines + 4, "fertigungsstatus.Show"
.InsertLines .CountOfLines + 5, "End Sub"
End With
I just have to write a Sub npw, who checks, if this code exists for all existing labels on sheet and then im done :)