View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tim Childs Tim Childs is offline
external usenet poster
 
Posts: 128
Default Macro shortcut keys

Diane

you could try this "kludgy" technique


good luck

Tim

PS if this code won't work, am happy to send you the file
that work!

Option Explicit

'Because these procedures use the DataObject variable
type,
'you must have a reference set in your VBA project to the
Microsoft Forms 2.0 object library.
Declare Function GetForegroundWindow Lib "user32.dll" ()
As Long

Sub foo()
Dim testing
Dim bFound As Boolean
Dim iCounter As Integer
Dim iTotalMacroNo As Integer
Dim MacroNames(12, 2)

If IsVBEActive Then Exit Sub

Range("A9").Select

'testing = GetOffClipboard
'MsgBox testing
Application.SendKeys ("%TMM{TAB 2}{UP 12}{TAB}") 'set for
all open workboooks
Application.SendKeys ("{ESC 2}") 'quit

iCounter = 1
Do While bFound = False
DoEvents
Application.SendKeys ("{DOWN}")
Application.SendKeys ("%TMM") 'start
Application.SendKeys ("{TAB}{DOWN " & iCounter - 1 & "}
{TAB 8}")
'
Application.SendKeys ("{F2}{END}")
Application.SendKeys ("+{HOME}")
Application.SendKeys ("^c")
Application.SendKeys ("{ESC}") 'quit
Application.SendKeys ("^v")

'Range("A20").Value = GetOffClipboard

'Range("A9").Offset(iCounter, 0).Select
'Application.SendKeys ("^v{DOWN}")
'Range("A9")(2, 1) = Range("A1").Value '"test" '.Offset
(iCounter, 1)
'Range("A9")(1 + iCounter, 1) = Range("A1") '.Select
'Application.SendKeys ("^v~")

'Cells(9 + iCounter, 2) = Range("a1")

If iCounter = 200 Then bFound = True
DoEvents
Application.SendKeys ("{DOWN}{UP}")

Debug.Print "iCounter = " & iCounter & " " &
Application.WorksheetFunction.CountIf(Range("A:A") ,
ActiveCell.Value)

If Application.WorksheetFunction.CountIf(Range("A:A") ,
ActiveCell.Value) 1 Then
bFound = True
ActiveCell.ClearContents
iTotalMacroNo = iCounter
End If







iCounter = iCounter + 1
Loop
'Exit Sub '
Range("B9").Select

For iCounter = 1 To iTotalMacroNo
Application.CutCopyMode = False
ActiveCell.Copy
DoEvents
Application.SendKeys ("{DOWN}")
Application.SendKeys ("%TMM") 'start
Application.SendKeys ("{TAB}{DOWN " & iCounter - 1
& "}%o")
'
Application.SendKeys ("{F2}{END}")
Application.SendKeys ("+{HOME}")
Application.SendKeys ("^c")
Application.SendKeys ("{ESC 2}") 'quit
Application.SendKeys ("^v")

Next iCounter


'Application.SendKeys ("{ESC 2}")


'Range("A20").Value = GetOffClipboard

End Sub

Public Sub PutOnClipboard(Obj As Variant)
Dim MyDataObj As New DataObject
MyDataObj.SetText Format(Obj)
MyDataObj.PutInClipboard
End Sub


Public Function GetOffClipboard() As Variant
Dim MyDataObj As New DataObject
MyDataObj.GetFromClipboard
GetOffClipboard = MyDataObj.GetText()
End Function


Public Sub ClearClipboard()
Dim MyDataObj As New DataObject
MyDataObj.SetText ""
MyDataObj.PutInClipboard
End Sub




Function IsVBEActive() As Boolean
Dim hWndP1 As Long
Dim hWndP2 As Long
hWndP1 = Application.VBE.MainWindow.hwnd
'Find the active window
hWndP2 = GetForegroundWindow
IsVBEActive = (hWndP1 = hWndP2)
End Function