Floating Message/Comment Box - vba

So pretty much what I am trying to do is create a floating text box that would be on the right of the spreadsheet. When a user selects a row/cell it will then place a comment or message with details about that cell in there rather than a small little comment box.
I have tried to use the UserForm Box but its not really what I'm looking for.
Example:
User Selects Cell A4, I would like a message to read in a floating text when that cell is selected. Then if a user selects Cell B6 a different message appears in that box.
Does that makes sense?
Update:
The Following Code Shows a UserForm box when a certain cell is selected:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Definition As String
If Intersect(Target, Range("C6:D6")) Is Nothing Then Exit Sub
Select Case Target.Row
Case 22
Definition = "Text Here"
Case 23
Definition = "Text Here Again"
End Select
UserForm1.Label1.Caption = Definition
UserForm1.Show
End Sub
I don't want to use a UserForm box as its not stationary on the Worksheet itself. I want it so a Text Box that always appears on the right hand side of the worksheet to display a set message or context when the cell is selected. It will be different then what is stored in the actual cell.

Use a Data Validation message. This type of message "pops-up" whenever you click on a cell:

You can place a Label or TextBox control directly in the worksheet - make sure it's an ActiveX control, not a Forms control - and position it dynamically using the worksheet's SelectionChange event:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Me.lblText
.Visible = False
Select Case Target.Row
Case 22
.Caption = "Text Here Again"
Case 23
.Caption = "Text Here Again"
Case Else
.Visible = False
Exit Sub
End Select
' Place the label to the right of the target cell
.Left = Target.Left + Target.Width
' Or place the label in the far left of the window
'.Left; =; Application.ActiveWindow.VisibleRange.Width; -; .Width
.Top = Target.Top - 0.75 ' cell borders
.Visible = True
End With
End Sub
Some hints:
Make sure the 'Placement' property of a label is 2
(XlPlacement.xlMove), as other values give you Free-Floating or
Move-and-Size.
I strongly advise you to set the background colour of the control to
&H80000004&, the predefined Windows scheme colour for menu and form
backgrounds; likewise, the foreground to &H80000008&, the menu text
colour. This ensures visibility for users who have their own colour
settings, and explicitly supports users who specify an accessible or
assistive colour scheme to ameliorate a visual impairment.
My code relies on your sheet supporting event procedures in VBA, and
on ActiveX controls. It won't work in .xlsx sheets, and it may be
blocked (or accompanied by warning dialogues) if your operating
environment has a heavy-handed security policy.
Copy-and-paste might be affected by my use of the Worksheet
SelectionChange event.
Right-Click the control in design view for the 'Format Control' menu
and uncheck 'Print Control' - if the users print the sheet, they'll
want to see the cell contents, not the label.
Also: the label's in the way of selecting and editing the control
it's sitting over. Maybe you want it 4-5mm to the right, so the users
can get the mouse into that cell. Alternately, do this in the label's
Click() or MouseMove event:
Me.lblText.Visible = False
You might draw an obvious conclusion from all this: the native comment or data validation label is a better bet than using forms and ActiveX controls.

Related

How to add userform into this code instead of msgbox?

I currently have this code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
For Each myCell In Range("G4:G160")
If (Not IsEmpty(myCell)) And myCell.Value <> 17521 And myCell.Value <> "" Then
DisplayUserForm
Exit Sub
End If
Next myCell
End Sub
and have this for my userform
Sub DisplayUserForm()
Dim form As New WarningBox
form.LOL.Caption = "INCORRECT!"
form.Show
Set form = Nothing
End Sub
What else must I do in order for this to appear instead of msgbox to alert whoever is entering data will be showing "INCORRECT!" in bold and Surrounded by red.
Please see image below of what I am trying to show
Please follow these steps:
Insert a new Form by right-clicking on your VBA project and selecting UserForm under the Insert option.
Click once on the created form and then press the ``F4key to open theProperties``` window.
On the Properties window, the default name for your form is UserForm1. Change it to any new value as you want (e.g., WarningBox)
From the ToolBox window, drag and drop a Label on your form and adjust its size, font, font color, and all other properties that exist on the Properties window. Please rename the label to message. I will use this name later when calling the form to be shown.
If you want, like step 4, add a CommandButton to your form and change its name to for example okButton and adjust other properties as you want.
Double click on the button to write the code for this button. Write the code as follows:
Private Sub okButton_Click()
'Close the form
Unload Me
End Sub
Now, modify your DisplayUserForm() sub as follows:
Sub DisplayUserForm()
Dim form As New warningBox
form.message.Caption = "write your message here"
form.Show
Set form = Nothing
End Sub
All will be done as you want!
Marc: if your "Incorrect" message is the "LOL" object whose caption you modify with the code form.LOL.Caption = "INCORRECT!", it will be editable if it is a TextBox object. Saeed Sayyadipour's example shows using a Label object, instead, that will not be editable by the user (and I 'second' his advice about the "OK" button).
Also, though, since the event tells you which cells were changed by defining the "Target" range object, do you really need to loop through all of G4:G160, since only the cells within Target were changed by the user? Perhaps use For Each MyCell in Intersect(Target,Range("G4:G160")), or perhaps add these lines where appropriate:
Dim AffectedCells as Range
...
Set AffectedCells=Intersect(Target,Range("G4:G160"))
...
Set AffectedCells=Nothing
and change your loop to:
For Each myCell in AffectedCells
...
Next myCell
If there is no overlap between the changed range (Target) and your G4:G160, nothing happens and your code exits quickly.

Creating shapes in similar fashion as with autoshape dropdown

I would like to make a macro in Powerpoint that enables me to create shapes in a similar fashion as when you select the autoshapes in the autoshape overview (i.e. once you call the macro you have a possibility to click to set the coordinates and subsequently you drag and click to set the width&height). Also, I would like to give it pre-set cosmetic characteristics (e.g. certain inner margins, fill color, border style and transparancy), which will be defined in the vba code.
I am aware of .addshapes(), however, this requires coordinates and height/width as input. Moreover, I have not find any posts / documents on vba to create shapes without defined coordinates and height/width.
Anyone some ideas on how to tackle this challenge?
Many thanks in advance!
Sofar
Building on what John Korchok suggested, here's code that retrieves the just-drawn shape so that your code can resume and manipulate it...
Sub testAppComBars()
Dim SHP As Shape
Application.CommandBars.ExecuteMso ("ShapeFreeform")
Stop
Set SHP = Selection.ShapeRange(1)
With SHP.Fill
.ForeColor.RGB = RGB(192, 0, 0)
.Transparency = 0.75
End With
End Sub
I would hope there's a more elegant solution than using Stop to pause code execution while the user picks the shape's location (or in this case, draws a freeform polyline/polygon), but that's all I could come up with off the top of my head.
I was fascinated by this problem and think this might help you.
Consider that when you draw a new autoshape, you have changed the window selection, and created a new selection ShapeRange with exactly 1 item (the new shape).
So by setting a WindowSelectionChange event, you're able to apply any formatting you wish at the time of creation.
First create a class module called cPptEvents with the following:
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal sel As Selection)
On Error GoTo Errhandler
Debug.Print "IN_PPTEvent_WindowSelectionChange"
Dim oShp As Shape
If (ActiveWindow.ViewType = ppViewNormal) Then
With sel
If .Type = ppSelectionShapes Then
If .ShapeRange.Count = 1 Then
Set oShp = .ShapeRange(1)
If oShp.Type = msoAutoShape Then
If oShp.AutoShapeType = msoShapeOval Then
If oShp.Tags("new_oval") = "" Then
oShp.Fill.ForeColor.RGB = RGB(255, 0, 0)
oShp.Tags.Add "new_oval", "true"
End If
End If
End If
End If
End If
End With
End If
Exit Sub
Errhandler:
Debug.Print "Error: " & Err.Description
End Sub
This checks the selection every time it changes. If there's an oval selected, it looks for the "new_oval" tag, which will not exist for a newly created shape. In that case, it applies a red fill, although of course once you get to this point you can call an entirely different sub, pass along the shape, and do whatever you want formatting-wise to it.
By adding that "new_oval" tag, you ensure that the formatting will not be applied to an oval that hasn't been newly created. This allows the user to make manual changes to the formatting as needed -- otherwise you're just resetting the formatting every time the user selects an oval.
Note that for the _WindowSelectionChange event to be running in the background, you have to call this at some point:
Public MyEventClassModule As New cPptEvents
'
Public Sub StartMeUp()
Set MyEventClassModule.PPTEvent = Application
End Sub
You can include that one line from StartMeUp above in whatever Ribbon_Onload sub is triggered by your addin, if you're making a new addin ribbon.
With this solution, you don't even have to give the end user a special button or set of tools to create the shapes that are being formatted. It happens invisibly whenever the user draws a new shape from the native PPT tools.
This will put your cursor in drawing mode to draw an oval. After running, you may have to click on the slide once, then the cursor will change shape and you can draw an oval:
Sub DrawOval()
Application.CommandBars.ExecuteMso ("ShapeOval")
End Sub
Other commands to substitute for ShapeOval:
ShapeRectangle
ShapeElbowConnectorArrow
ShapeStraightConnectorArrow
Get the full list in Excel spreadsheets from Microsoft Office 2016 Help Files: Office Fluent User Interface Control Identifiers
Look for the powerpointcontrols.xlsx file and search the first column with "shape"
There are 173 shapes in the menu, so you have a lot of macros to write.

Excel displays duplicate calendar picker control (Macros VBA)

I've created a macros-enabled Excel file where, when clicking into a specific cell, a pop-up calendar appears. It is an ActiveX control (Microsoft Date and Time Picker Control 6.0 (SP4)). From time to time the calendar control appears next to the clicked cell and is unclickable and a duplicate control appears in the left top corner of the worksheet and this one is clickable.
I would like it to appear just next to the clicked cell. What could be wrong?
Sub Worksheet_SelectionChange(ByVal Target As Range)
With Sheet1.startPicker
If Not Intersect(Target, Range("E2:E10000")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Right = Target.Offset(0, 1).Right
Else
.Visible = False
End If
End With
End Sub
Private Sub startPicker_Change()
ActiveCell.Value = Me.startPicker.Value
End Sub
When I click on the date picker control in Design Mode, then the name is set to startpicker and in the formula bar it says "=EMBED("MSComCtl2.DTPicker.1";"")"
Just now I tried changing the Checkbox (in the Calendar Properties) to True. Then when I went back, the duplicate one was gone. Changed it back to False and it didn't return.

VBA: Code not running after ToggleFormsDesign

I have the following code in VBA (MS Word), that is meant to run after I click in a button, named cmdFormPreencher inserted in my Document:
Private Sub cmdFormPreencher_Click()
'
If ActiveDocument.FormsDesign = False Then
ActiveDocument.ToggleFormsDesign
End If
'
ThisDocument.cmdFormPreencher.Select
ThisDocument.cmdFormPreencher.Delete
ActiveDocument.ToggleFormsDesign
'
UserForm2.Show
End Sub
The purpose of the code above is to delete that button inserted in my document.
But when I run the code only the button is selected. When I tried to figure out what is happening by debugging, it showed me the code runs until ActiveDocument.ToggleFormsDesign and not running the code remaining
Is this a bug of VBA, or am I doing something wrong? If so, how can I get around this problem?
Thanks!
Note: The ActiveX button is not in Header and Footer. The Text Wrap is set to In Front of Text
Edit:
When I try to run a macro, activating FormDesign, Selecting the ActiveX button and then deleting, I get this code:
Sub Macro1()
'
' Macro1 Macro
'
'
ActiveDocument.ToggleFormsDesign
ActiveDocument.Shapes("Control 52").Select
Selection.ShapeRange.Delete
ActiveDocument.ToggleFormsDesign
End Sub
But when I run this code nothing happens...
This is by design. When an Office application is in Design Mode code should not run on an ActiveX object that's part of the document.
I take it this is an ActiveX button and in that case, it's a member of the InlineShapes or Shapes collection - Word handles it like a graphic object. It should be enough to delete the graphical representation, which you can do by changing it to display as an icon instead of a button.
For example, for an InlineShape:
Sub DeleteActiveX()
Dim ils As word.InlineShape
Set ils = ActiveDocument.InlineShapes(1)
ils.OLEFormat.DisplayAsIcon = True
ils.Delete
End Sub
You just have to figure out how to identify the InlineShape or Shape. You could bookmark an InlineShape; a Shape has a Name property.
EDIT: Since according to subsequent information provided in Comments you have a Shape object, rather than an InlineShape, the following approach should work:
Dim shp As word.Shape
Set shp = ActiveDocument.Shapes("Shape Name") 'Index value can also be used
shp.Delete
Note that Word will automatically assign something to the Shape.Name property, but in the case of ActiveX controls these names can change for apparently no reason. So if you identify a control using its name instead of the index value it's much better to assign a name yourself, which Word will not change "on a whim".
Activate Design Mode.
Click on the control to select it
Go to the VB Editor window
Ctrl+G to put the focus in the "Immediate Window"
Type the following (substituting the name you want), then press Enter to execute:
Selection.ShapeRange(1).Name = "Name to assign"
Use this Name in the code above

VBA ActiveX dynamic ComboBox reduces ListRows to 1

I am trying to get a VBA ComboBox to dropdown and display only those items which match or partially match the typed string.
For this purpose, I have set up a ComboBox KeyUp event manager, as follows:
Public Sub TempCombo_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
'If TAB is pressed, then move one place right
ActiveCell.Offset(0, 1).Activate
Case 13
'If Enter is pressed, then move one place down
ActiveCell.Offset(1, 0).Activate
Case Else
'Otherwise, filter the list from the already entered text
Dim x As Long
OriginalValue = Me.TempCombo.Value
'Remove items from the ComboBox list
If Me.TempCombo.ListCount > 0 Then
For i = 1 To Me.TempCombo.ListCount
Me.TempCombo.RemoveItem 0
Next
End If
'If any part of any element from the 'FullSource' array matches the so far typed ComboBox value, then include it in the list for dropdown
For x = 1 To UBound(FullSource)
Typed_Value = "*" & LCase(OriginalValue) & "*"
If LCase(FullSource(x)) Like Typed_Value Then
Me.TempCombo.Object.AddItem FullSource(x)
End If
Next
Me.TempCombo.Value = OriginalValue
Me.TempCombo.ListRows = 12
Me.TempCombo.DropDown
End Select
End Sub
The code seems to do the filtering fine. But the dropdown list height is only one unit tall. I have to scroll through this small box, using the mouse buttons.
Why the dropdown list reduces in size is a mystery to me, and I'd appreciate if any light can be thrown on this. Perhaps there is some setting that I am overlooking.
Thanks
You can use Me.TempCombo.Height = 15 to set the height.
If it doesn't work, you are probably running into ActiveX control instability issues. Refer to Excel VBA ComboBox DropDown Button Size--changed itself to use form controls instead of ActiveX.
Dynamically adjusting the width of a combobox in Excel VBA for more details on setting this dynamically.