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
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.
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.
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.
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.
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?
is passing the button object as a parameter to the script..DOM.Script.StartTimer Worksheets(1).Buttons(1)
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.
in message news:[email protected]
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>
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.