Floating Command button
Probyn
as I scroll around. I would like to achieve this without using the menu
bar or placing the button above a a Freeze Pane.
Thanks
Ardus Petus
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Me.CommandButton1
.Top = ActiveCell.Top
.Left = ActiveCell.Left + 2 * ActiveCell.Width
End With
End Sub
HTH
--
AP
"Probyn" <proby...@yahoo.com> a écrit dans le message de news:
1149343927.4...@u72g2000cwu.googlegroups.com...
Probyn
This routine move the command button to 2 place of the selected cell.
Is there a way to keep the Command Button in place as I scroll around
the sheel.
Thanks.
Probyn
Looking at your code It would seems that if code the Command button to
move opposited to and in response to the sheet scrolling that should
work. Any idea how to write the code to respond to the scrolling
event. Thanks
Dave Peterson
--
Dave Peterson
Miyahn
> Is there a way to make a command button stay in place in Excel sheet
> as I scroll around. I would like to achieve this without using the menu
> bar or placing the button above a a Freeze Pane.
The following is an example.
If you are using Excel2003, you will receive an alert when opening the book.
To avoid this alert, you must change security setting by ORK.
Option Explicit
Sub Auto_Close()
On Error Resume Next
Worksheets(1).DHTMLEdit1.DOM.Script.StopTimer
On Error GoTo 0
End Sub
Sub Auto_Open()
SetTimer
End Sub
'
Private Sub SetTimer()
Dim aObject As Object, Found As Boolean
With Worksheets(1)
For Each aObject In .OLEObjects
If aObject.Name = "DHTMLEdit1" Then Found = True
Next aObject
If Not Found Then
On Error Resume Next
.OLEObjects.Add "DHTMLEdit.DHTMLEdit.1"
On Error GoTo 0
End If
If .Buttons.Count = 0 Then .Buttons.Add 0, 0, 75, 25
End With
Application.OnTime Now + TimeValue("00:00:01"), "StartTimer"
End Sub
'
Private Sub StartTimer()
Dim Src(20) As String
Src(0) = "<script Language = VBS>"
Src(1) = "Dim tId, Target, PX, PY"
Src(2) = "Sub MoveTimer()"
Src(3) = " On Error Resume Next"
Src(4) = " With Target.Parent.Application"
Src(5) = " P = Target.Parent.Columns(.ActiveWindow.ScrollColumn).Left"
Src(6) = " If P <> PX Then Target.Left = P: PX = P"
Src(7) = " P = Target.Parent.Rows(.ActiveWindow.ScrollRow).Top"
Src(8) = " If P <> PY Then Target.Top = P: PY = P"
Src(9) = " End With"
Src(10) = " On Error GoTo 0"
Src(11) = "End Sub"
Src(12) = "Sub StartTimer(Arg)"
Src(13) = " Set Target = Arg: If tId <> 0 Then StopTimer"
Src(14) = " tId = Window.setInterval(""MoveTimer"", 100)"
Src(15) = "End Sub"
Src(16) = "Sub StopTimer()"
Src(17) = " Set Target = Nothing: Window.clearInterval tId"
Src(18) = " tId = 0"
Src(19) = "End Sub"
Src(20) = "</script>"
With Worksheets(1).DHTMLEdit1
.Width = 0: .Height = 0: .BrowseMode = True
.DocumentHTML = Join(Src, vbCrLf)
Do While .Busy: DoEvents: Loop
.DOM.Script.StartTimer Worksheets(1).Buttons(1)
End With
End Sub
--
Miyahn (Masataka Miyashita) JPN
Microsoft MVP for Microsoft Office - Excel(Jan 2006 - Dec 2006)
https://mvp.support.microsoft.com/profile=e971f039-a892-426c-9544-83d372c269b4
Probyn
Probyn
I find that this code generates the command button but how do I attach
my macro to this button and how do I make more than one button.
Regards
Miyahn
> I find that this code generates the command button but how do I attach
> my macro to this button and how do I make more than one button.
My example is for demonstration, so create a DHTMLEdit object and
one command button object dynamicaly.
You can add these objects by manual operation.
If the book already has these objects, necessary code is,
Option Explicit
Sub Auto_Close()
Worksheets(1).DHTMLEdit1.DOM.Script.StopTimer
End Sub
'
Sub Auto_Open()
Dim Src(20) As String
Src(0) = "<script Language = VBS>"
Src(1) = "Dim tId, Target, PX, PY"
Src(2) = "Sub MoveTimer()"
Src(3) = " On Error Resume Next"
Src(4) = " With Target.Parent.Application"
Src(5) = " P = Target.Parent.Columns(.ActiveWindow.ScrollColumn).Left"
Src(6) = " If P <> PX Then Target.Left = P: PX = P"
Src(7) = " P = Target.Parent.Rows(.ActiveWindow.ScrollRow).Top"
Src(8) = " If P <> PY Then Target.Top = P: PY = P"
Src(9) = " End With"
Src(10) = " On Error GoTo 0"
Src(11) = "End Sub"
Src(12) = "Sub StartTimer(Arg)"
Src(13) = " Set Target = Arg: If tId <> 0 Then StopTimer"
Src(14) = " tId = Window.setInterval(""MoveTimer"", 100)"
Src(15) = "End Sub"
Src(16) = "Sub StopTimer()"
Src(17) = " Set Target = Nothing: Window.clearInterval tId"
Src(18) = " tId = 0"
Src(19) = "End Sub"
Src(20) = "</script>"
With Worksheets(1).DHTMLEdit1
.DocumentHTML = Join(Src, vbCrLf)
Do While .Busy: DoEvents: Loop
.DOM.Script.StartTimer Worksheets(1).Buttons(1)
End With
End Sub
To attach your macro to the button, right click the button -> [Attach Macro]
(I am not sure expression of menu item in english version.)
For more than one button, modify DHTMLEdit1.DocumentHTML's script to
Accept collection of objects
Set appropriate position for each object
and pass buttons collection to the script.
Probyn
I did not use Scripting language before so this is a little difficult
for me. Your first set of codes I attached to the work sheet and it
created the command button dynamically. However when I right-clicked
the 'Assigned Macro' option was not selectable. Your second set of
codes I do not understand if should be in the worksheet, a module or
attached to the command button. Also, how does the code reference the
command button? Let's assume I have two command buttons name
TestButton1 and TestButton2 in TestWorksheet1 please demonstrate the
code for this.
Much thanks.
Miyahn
> Thanks again Miyahn,
>
> I did not use Scripting language before so this is a little difficult
> for me. Your first set of codes I attached to the work sheet and it
> created the command button dynamically. However when I right-clicked
> the 'Assigned Macro' option was not selectable.
VBS is very similar to VBA.
Right-click on the point where mouse pointer changes to cross-arrows.
> Your second set of
> codes I do not understand if should be in the worksheet, a module or
> attached to the command button.
Paste into the standard module.
>Also, how does the code reference the command button?
This line
> .DOM.Script.StartTimer Worksheets(1).Buttons(1)
is passing the button object as a parameter to the script.
--
Miyahn (Masataka Miyashita) JPN
Microsoft MVP for Microsoft Office - Excel(Jan 2006 - Dec 2006)
https://mvp.support.microsoft.com/profile=e971f039-a892-426c-9544-83d372c269b4
If you can read Japanese,
Miyahn's Archive: http://homepage2.nifty.com/miyahn/
Probyn
automatically generated button. I am unable to work with the manual
code. Would you please add the code to your program below to make say
4 command buttons. This migh help me to understand the code a little
more. Thanks.
Dim Src(20) As String
Src(0) = "<script Language = VBS>"
Src(1) = "Dim tId, Target, PX, PY"
Src(2) = "Sub MoveTimer()"
Src(3) = " On Error Resume Next"
Src(4) = " With Target.Parent.Application"
Src(5) = " P =
Target.Parent.Columns(.ActiveWindow.ScrollColumn).Left"
Src(6) = " If P <> PX Then Target.Left = P: PX = P"
Src(7) = " P = Target.Parent.Rows(.ActiveWindow.ScrollRow).Top"
Src(8) = " If P <> PY Then Target.Top = P: PY = P"
Src(9) = " End With"
Src(10) = " On Error GoTo 0"
Src(11) = "End Sub"
Src(12) = "Sub StartTimer(Arg)"
Src(13) = " Set Target = Arg: If tId <> 0 Then StopTimer"
Src(14) = " tId = Window.setInterval(""MoveTimer"", 100)"
Src(15) = "End Sub"
Src(16) = "Sub StopTimer()"
Src(17) = " Set Target = Nothing: Window.clearInterval tId"
Src(18) = " tId = 0"
Src(19) = "End Sub"
Src(20) = "</script>"
With Worksheets(1).DHTMLEdit1
.Width = 0: .Height = 0: .BrowseMode = True
Miyahn
> Miyahn thanks for your time. I am now able to assign a macro to the
> automatically generated button. I am unable to work with the manual
> code.
Do you mean that you can use only the macro created by 'Macro Recording'?
Well, the update version is here.
Option Explicit
Const MaxN = 4, HGap = 100, VOfs = 50, BW = 75, BH = 25
Const BCap = "TestButton", ModuleName = "Module1"
Sub Auto_Close()
On Error Resume Next
Worksheets(1).DHTMLEdit1.DOM.Script.StopTimer
On Error GoTo 0
End Sub
Sub Auto_Open()
SetTimer
End Sub
Private Sub SetTimer()
Dim aObject As Object, Found As Boolean, I As Long
With Worksheets(1)
For Each aObject In .OLEObjects
If aObject.Name = "DHTMLEdit1" Then Found = True
Next aObject
If Not Found Then
On Error Resume Next
.OLEObjects.Add "DHTMLEdit.DHTMLEdit.1"
On Error GoTo 0
End If
If .Buttons.Count = 0 Then
For I = 1 To MaxN
.Buttons.Add(HGap * I, VOfs, BW, BH).Caption = BCap & CStr(I)
Next
End If
End With
Application.OnTime Now + TimeValue("00:00:01"), "StartTimer"
End Sub
Private Sub StartTimer()
Dim Buf As String
With Application.VBE.ActiveVBProject.VBComponents(ModuleName).Codemodule
Buf = .Lines(1, .CountOfLines)
End With
With CreateObject("VBScript.RegExp")
.Pattern = "' <script language=vbs>\r\n([\s\S]+)' </script>"
Buf = .Execute(Buf)(0)
End With
Buf = Replace(Buf, "HGap", CStr(HGap)): Buf = Replace(Buf, "VOfs", CStr(VOfs))
With Worksheets(1).DHTMLEdit1
.Width = 0: .Height = 0: .BrowseMode = True
.DocumentHTML = Replace(Buf, "'", "")
Do While .Busy: DoEvents: Loop
.DOM.Script.StartTimer Worksheets(1).Buttons
End With
End Sub
' <script language=vbs>
' Dim tId, cTarget, PX, PY
' Sub MoveTimer()
' Dim P, IsScrolled, I
' On Error Resume Next
' With cTarget.Parent.Application
' P = cTarget.Parent.Columns(.ActiveWindow.ScrollColumn).Left
' IsScrolled = (P <> PX): PX = P
' P = cTarget.Parent.Rows(.ActiveWindow.ScrollRow).Top
' IsScrolled = IsScrolled Or (P <> PY): PY = P
' End With
' If IsScrolled = False Then Exit Sub
' For I = 1 To cTarget.Count
' cTarget(I).Left = PX + HGap * I
' cTarget(I).Top = PY + VOfs
' Next
' On Error GoTo 0
' End Sub
' Sub StartTimer(Arg)
' Set cTarget = Arg: If tId <> 0 Then StopTimer
' tId = Window.setInterval("MoveTimer", 100)
' End Sub
' Sub StopTimer()
' Set cTarget = Nothing: Window.clearInterval tId: tId = 0
' End Sub
' </script>
Probyn
following error when I run the program:
Run-time error '1004'
Progrmmatic access to Visual Basic Project is not trusted.
The error is associated with the following line
With
Application.VBE.ActiveVBProject.VBComponents(ModuleName).Codemodules.
Also, does changing MaxN only determine the number of buttons.
Miyahn wrote:
> "Probyn" wrote in message news:1149561213.4...@c74g2000cwc.googlegroups.com
> > Miyahn thanks for your time. I am now able to assign a macro to the
> > automatically generated button. I am unable to work with the manual
> > code.
>
> Do you mean that you can use only the macro created by 'Macro Recording'?
When I tried to use the manual code you sent (that is the code that
does not dynamically create the command button). I created two command
buttons using the Control Tool Box. I named the controls, Button1 and
Commandbutton1. But I could not figure out how to connect the code and
those command buttons and so the float did not work.
Thanks again.
Miyahn
> Thanks again Miyahn. There is one problem with the new code. I get the
> following error when I run the program:
>
> Run-time error '1004'
> Progrmmatic access to Visual Basic Project is not trusted.
See this KB's article.(I assume that your Excel's version is 2002)
http://support.microsoft.com/kb/282033/en-us
Change security option at your own risk.
Probyn
It is now working fine. I will now experiment with some parameter
modify different settings.
Thank you.