I would like to get accurate Shape position in Excel. I noticed that Shape.Top is being disturbed by Windows Display Zoom settings.
To reproduce the bug, please right click on a sheet name > View code > and paste the VBA code in the sheet VBA editor.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
On Error Resume Next
ThisWorkbook.ActiveSheet.Shapes("BlueRectangle").Delete
Dim sh As Object
Set sh = ThisWorkbook.ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height)
sh.Name = "BlueRectangle"
End Sub
This code creates Rectange shape in the double clicked cell. Everything works fine as long as the display zoom of Windows settings is set up to 100%. However when we change display zoom in Windows settings to 125% then the rectangle is created in a slightly different place than the Active cell. There is a difference of 1 row in the location height for every 100 rows of Excel. So, when I click A100 cell then the Rectangle is created in A99 cell.
I would like to correct the location Rectangle creation so that Windows Zoom Display is taken into account.
Here is behavior with 100% Display Zoom:
Here is a buggy behavior I would like to fix which happens with 125% Display Zoom:
Here is the related inconspicuous challenge I threw on SO which might be a milestone in answering this question:
Get Windows display zoom value
I cannot reproduce your issue. I'm working with 150% and positioning is correct in Excel even for the very last cells.
Also there should be nothing need to be corrected.
But there might be some issues with your code:
Avoid ThisWorkbook.ActiveSheet and use Target.Parent this is more reliable.
Also avoid using ActiveCell and use Target because ActiveCell might not have changed to the cell you clicked on yet. Target is the cell you doubleclicked not ActiveCell.
Give the follwing a try. I doupt that the DPI is the issue and I suspect it is a ActiveCell related issue.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
On Error Resume Next
Target.Parent.Shapes("BlueRectangle").Delete
On Error GoTo 0 'always re-activate error handling after an expected error
Dim shp As Shape
Set shp = Target.Parent.Shapes.AddShape(msoShapeRectangle, Target.Left, Target.Top, Target.Width, Target.Height)
shp.Name = "BlueRectangle"
End Sub
Related
I have an ActiveX Textbox on an Excel worksheet. I need to move this textbox around and change its visibility using VBA frequently as you interact with the program. The issue is whenever I change the textbox visibility or position, it briefly flashes white before reacting to the code. Here is a video of what I'm talking about. In this video, the code is designed to move the textbox (which has a grey background), to position itself directly over the active cell whenever the selection changes. You can see when it moves over a cell with a yellow background. Then when I change the selection to leave the yellow cell, you can see the textbox flicker white before moving to the new location and becoming grey again.
https://vimeo.com/709930517
Also heres a screenshot of the instant I click another cell after the textbox was placed over the yellow cell.
Before this image, the single textbox on the Worksheet was grey and placed over the yellow cell. You can see in the image after clicking above the yellow cell, the textbox has flickered white over the yellow cell. This is the white flicker. Also in this image, the textbox appears it has already moved to the new location (where I clicked), but its still visible in the old location as well! There's only 1 textbox on the worksheet!
This is super annoying because I have a lot of background colors and when the textbox flickers white it looks horrible.
This is my code:
WORKSHEET CODE
Private Sub RulesTextbox_KeyDown(ByVal keyCode As MSForms.ReturnInteger, ByVal shift As Integer)
Call MODTextbox_KeyDown(keyCode, shift, TextboxSheets.rules)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call MODWorksheet_SelectionChange(Target)
End Sub
MODULE CODE
Option Base 0
Option Explicit
Global activeCell As Range
Public Sub MODTextbox_KeyDown(ByVal keyCode As MSForms.ReturnInteger, ByVal shift As Integer)
End Sub
Public Sub MODWorksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Set activeCell = Target
Dim textbox As OLEObject
Set textbox = Worksheets(1).OLEObjects("MyTextbox")
Call MODResizeTextboxToMatchRange(textbox, Target)
With textbox
.Visible = False
.Visible = True
.Object.BackColor = RGB(220, 220, 220) 'light grey
End With
textbox.Object.Value = activeCell.Value2
textbox.Activate
Application.ScreenUpdating = True
End Sub
Public Sub MODResizeTextboxToMatchRange(ByRef textbox As OLEObject, ByRef selectedRange As Range)
If selectedRange Is Nothing Then
Exit Sub
End If
Dim totalWidth As Double
Dim totalHeight As Double
Dim top As Double: top = selectedRange.top
Dim left As Double: left = selectedRange.left
If selectedRange.MergeCells And selectedRange.Cells.Count = 1 Then
totalWidth = selectedRange.MergeArea.Width
totalHeight = selectedRange.MergeArea.Height
Else
totalWidth = selectedRange.Width
totalHeight = selectedRange.Height
End If
With textbox
.top = top + 1
.left = left + 1
.Width = totalWidth - 2
.Height = totalHeight - 2
End With
End Sub
I've tried various work-arounds to try and get this to work:
It doesnt matter if you reposition the textbox or make it invisible, it always fickers white first.
Application.ScreenUpdating = False has no effect. Neither does calling DoEvents immediately after changing the position.
Changing the transparency of the textbox to try and make it dissappear doesnt help either, you get the same white flicker
It's like causing any change to the control makes it flicker. I would love some kind of ScreenUpdating = False equivalent so I could just hide the textbox and set back to true when its repositioned. I don't know much about the internal workings of ActiveX. Is it an issue with my computer and not Excel?
Also using a regular form input will not work, I need ActiveX to be able to style the textbox, particularly increasing the font size for users.
Any help is appreciated thanks
Well I figured it out. I need to set the textbox to .Visible = False BEFORE it get's moved, then make it visible after the move.
And you also need to set the backstyle of the textbox to transparent, in the VBA properties before you run the program. When the program is running and the textbox is focused it WONT be transparent, but as soon as it loses focuses it becomes transparent which will eliminate the flicker.
And finally, the TEXT of the textbox may still flicker even if the background doesnt. You can overcome this by setting the font size to 0 before you change the position, then when the textbox arrives at the new location set the font size back to 12 via VBA. You will still see a very tiny version of the text in the flicker, so to take it a step further in addition to setting the font size to 0 you can change the color of the font in the textbox via VBA to match the background color of the cell behind it, again switching back to regular font color once the textbox has been moved.
Wow I had no idea it was so simple!
I am trying since 2 days to find how to do the following without finding anything that suits the aim:
Steps by order :
user open excel file
he chose between folowing :
Paste an image directly in the worksheet (may be an limited area)
activate some video in the workbook (may be a webcam for start)
he select with a button to activate his clicks detection
he clicks anywhere on the picture and i get the coordinates of clicked points
So far i've seen ppl using (and tested myself) :
mouse event ==> this does not work as i need to know the name of what he is clicking on and it may be a brand new picture he just pasted
BeforeDoubleClick (same, i'd prefer avoid doubleclick but even then it doesnt work when i click on something else but cells)
Selectionchange ==> doesnt work if im not clicking on cells
Place hidden button over the area i want : i cant click a button if its not visible, and it becomes visible when i click it if i put as transparent
If anyone has ideas about this...
(nb: im not a pro of vba so i may have missed something)
Just forgot : my issue is not getting the coordinates of mouse, its just triggering the macro when i want, for now im jsut trying to get a simple msgbox to see if trigger works.
Thanks if anyone has any ideas
BR
Not sure if this fits your need (for example couldn't test it with a video).
a) Place a "button" of any kind on your sheet. I usually use a square shape for that and format it a little bit (color, shade, text). Assign the subroutine SetEvents to it.
b) Declare a global variable that remembers that click-activation is active
Option Explicit
Global EventCatchingActive As Boolean
c) In the event routine of your button, set the OnAction-method for all shapes of the sheet - see the routine setEvents. This ensures that even newly added images handle the click event.
Sub setEvents()
' This routine is called from the magic button.
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1) ' Set this to whatever sheet you need
Dim button As Shape
Set button = ws.Shapes(Application.Caller)
If EventCatchingActive Then
EventCatchingActive = False
button.TextFrame2.TextRange.Characters.Text = "Start Clicking"
Else
Debug.Print "Setting EventHandler"
Dim sh As Shape
For Each sh In ThisWorkbook.Sheets(1).Shapes
' Debug.Print sh.Name, sh.Type
If sh.Name <> button.Name Then sh.OnAction = "ClickedMe"
Next
EventCatchingActive = True
button.TextFrame2.TextRange.Characters.Text = "Stop Clicking"
End If
End Sub
d) Declare a routine that is called if any of the shapes is clicked. With Application.Caller you can check what was clicked.
Sub ClickedMe(Optional target As Range = Nothing)
If Not EventCatchingActive Then Exit Sub
If target Is Nothing Then
Debug.Print "I clicked on " & Application.Caller
Else
Debug.Print "I clicked on cell " & target.Address
End If
End Sub
(note that code of steps b) to d) goes into a regular module)
e) If you also want to handle clicks on a cell, add the following into the sheet-module of the worksheet you are dealing with.
Private Sub Worksheet_SelectionChange(ByVal target As Range)
ClickedMe target
End Sub
I am currently working on an Excel tool that I have equipped with one button and one shape-object.
The button is a select button to "select" the shape object. The idea is to Select a shape-object a Picture and change its color after selecting it.
I was able to locate the problem to the clicked Sub of the Select button.
To check if I'm correct I have written a the Macro Select_MyClicked and afterword used the call instruction to invoke the macro from within the Clicked-function of the select button.
Sub Select_MyClicked()
Dim ElementName As String
Dim Shp As Object
Set Shp = Sheets("Tabelle1").Shapes(ElementName)
Shp.Select
End Sub
==================================================================
Private Sub CommandButton3_Click()
Call Select_MyClicked
End Sub
==================================================================
What is interesting now is:
When I use the Button the Image is selected but in the Picture format register there i nothing selectable
If I cklick on the Image itselfe or use the Select_MyClicked Macro indepentently everything in the picture format register is selectable
I also tried to write the select instruction directly into the Button-Clicked private sub. Same result nothing selectable
What I want to do is select an image and change its color. My second question is does somebody know how to open the Colorpennel (with the many colored Rectangles) using vba ?
You need to reference the Shape by its Name. I assigned the name "myshape" to the Shape before running:
Sub Select_MyClicked()
Dim ElementName As String
Dim Shp As Shape
ElementName = "myshape"
Set Shp = Sheets("Tabelle1").Shapes(ElementName)
Shp.Select
End Sub
The code runs even if Tabelle1 is not the active sheet.
I have finally find the solution. It seems like it makes a difference which button you use. In my case it had to be the control elements not the activeX elements
I´m puzzled that Excel throws away the clipboard "copy" selection for no (obvious) reason when creating an auto-sized button.
Consider this simple selection change handler:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim P As Button: Set P = ActiveSheet.Buttons.Add(1, 1, 100, 100)
End Sub
This simple creates a dumb button on the top left corner of the sheet on every cell selection change.
If you press Ctrl-C in any cell (no matter if it´s empty or not), the cell will have this nice border indicating that the selection is what will be pasted if you select paste elsewhere.
That border will remain visible even if you navigate around on the sheet.
Now add one line:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim P As Button: Set P = ActiveSheet.Buttons.Add(1, 1, 100, 100)
P.AutoSize = True
End Sub
This makes the button(s) autosize themselves. Works fine. But from know on, every selection change will destroy the clipboard "copy" selection.
Why? Can I prevent this, or work around it?
Reproduced with Excel 10 14.0.7116.5000 32-bit :-O
If you have copied content then you will need to paste it before anything else happens. This is how Excel behaves naturally.
So, in your event, you can Paste the content (to the currently active cell) before Auto-Sizing the button.
Dim P As Button
If Application.CutCopyMode = xlCopy Then
Me.Paste
End If
Set P = ActiveSheet.Buttons.Add(1, 1, 100, 100)
'Application.EnableEvents = False
P.AutoSize = True
'Application.EnableEvents = True
EnableEvents is unnecessary here, but I've included it to indicate how you might prevent an event from triggering a second time. You probably need to work with it at some point.
I'm developing an Excel 2010 workbook, in a manual formulas calculation mode.
(file -> options -> formulas -> Workbook calculation -> manual)
I have some command buttons in the sheet (ActiveX controls), and I set them to move and size with cells (right click on the button -> format control -> Properties -> move and size with text).
This is since I have some rows filtered out under some conditions, and I want the buttons placed in these rows to appear and disappear as well, according to the display mode of their hosting rows.
It all goes perfectly fine, till I save he worksheet when some of the rows (hence buttons) are filtered out (i.e. not displayed).
When I re-open the file again, and expand the filtered rows, the buttons don't show. When checking their properties I see that their visible property is True, but their height is 0, and this doesn't change when I un-filter their hosting rows.
I want to emphasize again that before saving the file - both filtering and un-filtering the buttons worked well.
Would much appreciate any help here.
OK so I get the same results either with ActiveX or Form Controls. For whatever reason, it seems the control's original height does not persist beyond the save & close.
Another option would be to simply clear the AutoFilter on the Workbook's Close and Save events. However, this probably is not what you want if you like to leave some filter(s) on when you save and re-open the file. It's probably possible to save the filter parameters in a hidden sheet or by direct manipulation of the VBE/VBA, but that seems like a LOT more trouble than it's worth. Then you could re-apply the filter(s) when you re-open the workbook.
Here is what code I suggest
NOTE: I relied on the worksheet's _Calculate event with a hidden CountA formula (setting, changing, or clearing the AutoFilter will trigger this event). I put the formula in E1 just so you can see what it looks like:
Since your application relies on Calculation = xlManual then this approach will not work exactly for you but in any case, the subroutine UpdateButtons could be re-used. You would need to tie it in to another event(s) or functions in your application, as needed.
Here is the code
Option Explicit
Private Sub UpdateButtons()
'## Assumes one button/shape in each row
' buttons are named/indexed correctly and
' the first button appears in A2
Dim rng As Range
Dim shp As Shape
Dim i As Long
Application.EnableEvents = False
'## use this to define the range of your filtered table
Set rng = Range("A1:A6")
'## Iterate the cells, I figure maybe do this backwards but not sure
' if that would really make a difference.
For i = rng.Rows.Count To 2 Step -1
Set shp = Nothing
On Error Resume Next
Set shp = Me.Shapes(i - 1)
On Error GoTo 0
If Not shp Is Nothing Then
DisplayButton Me.Shapes(i - 1), Range("A" & i)
End If
Next
Application.EnableEvents = True
End Sub
Private Sub DisplayButton(shp As Shape, r As Range)
'# This subroutine manipulates the shape's size & location
shp.Top = r.Top
shp.TopLeftCell = r.Address
shp.Height = r.Height
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "_Change"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
''## Assumes one button/shape in each row
'' buttons are named/indexed correctly and
'' the first button appears in A2
'Dim rng As Range
'Dim shp As Shape
'Dim i As Long
'
''## Uncomment this line if you want an annoying message every time
''MsgBox "Refreshing Command Buttons!"
'
'Application.EnableEvents = False
''## use this to define the range of your filtered table
'Set rng = Range("A1:A6")
'
''## Iterate the cells, I figure maybe do this backwards but not sure
'' if that would really make a difference.
'For i = rng.Rows.Count To 2 Step -1
' Set shp = Nothing
' On Error Resume Next
' Set shp = Me.Shapes(i - 1)
' On Error GoTo 0
'
' If Not shp Is Nothing Then
' DisplayButton Me.Shapes(i - 1), Range("A" & i)
' End If
'Next
'
'Application.EnableEvents = True
End Sub
For Another option See this article. You can re-purpose existing commands with RibbonXML customization. While this article is geared towards C# and Visual Studio it's possible to do it with the CustomUI Editor.
I had a similar problem with buttons disapearing (moving on upper left corner) when removing filters.
A solution I found was to add a row above the columns headers so that buttons were still appearing at the top of the columns but were not touching the row where filters were placed.
Adding / removing filters stop interfering with buttons' positions.
I had a similar problem where form buttons appear to work fine, but then disappear after saving and reopening the workbook. Specifically this happened when the form button where part of hidden rows (done using vba code).
Seems like a real bug, although I don't know where the link is.
By changing the form buttons to ActiveX buttons, the buttons stopped disappearing, but started moving/bunching to the top of the screen when the rows were hidden. I just added some vba to re-position the buttons (e.g. CommandButton1.Top = Range(A12:A12).Top --> moves the ActiveX command button to the 12th row).