Autorun Excel vba code when cell value changes [duplicate] - vba

This question already has answers here:
Why MS Excel crashes and closes during Worksheet_Change Sub procedure?
(3 answers)
Closed 7 years ago.
I'm looking for a way to automatically start a certain Sub when the cell's value is Zero.
E.g. if I enter "0" into Cell A1 the following Sub is supposed to run
Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"
And if I enter 1 (or any other Value above 0) into Cell A1 another Sub should run, e.g.
Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
The calling of a Sub should happen right after I enter the value in excel, without pressing a button oder anything else.
Is there any way to do this?

Let's start with this code, which I will explain below.
Open the VB Editor Alt+F11. Right click the sheet that you want this behavior to occur on and select View Code.
Copy and paste the following code into the worksheet code.
Private Sub Worksheet_Change(ByVal Target As Range)
'CountLarge is an Excel 2007+ property, if using Excel 2003
'change to just Count
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$A$1" Then
If Target.Value = 0 Then
Me.Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"
ElseIf Target.Value = 1 Then
Me.Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
End If
End If
End Sub
The Worksheet_Change event is fired every time a user makes a change to the worksheet. If you change a cell value, for example, this event is triggered.
The first line within this subroutine checks to ensure that multiple cells weren't changed and that there was in fact an actual cell change, if either is not true then it will not continue.
Then we check to ensure that the value change happened in cell A1, if it did, we enter that IF statement.
From there, we check the value that was entered into cell A1. If the value was 0, the appropriate formula is added to H32. If the value was 1, the appropriate formula is added to B15. If a value other than 0 or 1 is entered into cell A1, nothing happens.
It is important to note that you must leave the cell for this event to trigger, so while this is a good start, I don't currently know of a way to get this event to fire without at least pressing enter or leaving the cell.
Update
After a bit of research and playing around, I've figured out how you can make this change without pressing enter or any other button, this will occur immediately after either '0' or '1' is pressed, even if you are editing the cell value. I used a keyboard handler from this previous SO question.
The code between the BEGIN KEYBOARD HANDLING and END KEYBOARD HANDLING event was from above.
Copy and paste the following code into the worksheet code of whichever sheet you want to capture these key strokes on:
Option Explicit
'BEGIN KEYBOARD HANDLING
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE As Long = &H1
Private Const WM_CHAR As Long = &H102
Private bExitLoop As Boolean
Sub StartKeyWatch()
Dim msgMessage As MSG
Dim bCancel As Boolean
Dim iKeyCode As Integer
Dim lXLhwnd As Long
'handle the ESC key.
On Error GoTo errHandler:
Application.EnableCancelKey = xlErrorHandler
'initialize this boolean flag.
bExitLoop = False
'get the app hwnd.
lXLhwnd = FindWindow("XLMAIN", Application.Caption)
Do
WaitMessage
'check for a key press and remove it from the msg queue.
If PeekMessage _
(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
'strore the virtual key code for later use.
iKeyCode = msgMessage.wParam
'translate the virtual key code into a char msg.
TranslateMessage msgMessage
PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
WM_CHAR, PM_REMOVE
'for some obscure reason, the following
'keys are not trapped inside the event handler
'so we handle them here.
If iKeyCode = vbKeyBack Then SendKeys "{BS}"
If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
'assume the cancel argument is False.
bCancel = False
'the VBA RaiseEvent statement does not seem to return ByRef arguments
'so we call a KeyPress routine rather than a propper event handler.
Sheet_KeyPress _
ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel
'if the key pressed is allowed post it to the application.
If bCancel = False Then
PostMessage _
lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
End If
End If
errHandler:
'allow the processing of other msgs.
DoEvents
Loop Until bExitLoop
End Sub
Sub StopKeyWatch()
'set this boolean flag to exit the above loop.
bExitLoop = True
End Sub
Private Sub Worksheet_Activate()
Me.StartKeyWatch
End Sub
Private Sub Worksheet_Deactivate()
Me.StopKeyWatch
End Sub
'End Keyboard Handling
Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As Range, Cancel As Boolean)
'CountLarge is an Excel 2007+ property, if using Excel 2003
'change to just Count
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$A$1" Then
If KeyAscii = 48 Then
Me.Range("H32").FormulaR1C1 = "=SUM(R[-4]C:R[-2]C)"
ElseIf KeyAscii = 49 Then
Me.Range("B15").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
End If
End If
End Sub
Additionally, right click on the ThisWorkbook object --> View Code, and add this code in:
Private Sub Workbook_Open()
Sheets("Sheet1").StartKeyWatch
End Sub
Be sure to change Sheet1 to whatever the name of your worksheet is.
The VBA will 'listen' for key presses and if the active cell is A1 and either a 0 or 1 is entered, the appropriate action will be performed even before the user does anything else.
I will add that his comes at a slight performance cost, as the code that executes on Workbook_Open takes a couple seconds to run.
Thanks to user Siddharth Rout for pointing out the potential issue with Count from Excel 2007 and on and directing me to use CountLarge instead.

Related

Programatic ListBox selection is selecting the wrong item

I am building an Excel VBA project which makes use of a ListBox to navigate through a tree structure. By double clicking an item it will expand below with additional items. My goal is that by making this selection the change will be made and the ListBox will update, whilst retaining the selection just clicked by the user and keeping it in view.
I have created a separate workbook to isolate the problem I have to make it simpler, and I will be able to replicate any solutions into my original project.
My ListBox is populated using RowSource. Values are stored on a sheet (for genuine reasons I'll omit from this post to keep it to the point), changes are made to the sheet and then RowSource is called again to update the ListBox. By doing this the ListBox will update and then jump down to where the selection made is the last item in the view, but the list item now selected is the one in the position of the previous selection which is incorrect.
Example:
User scrolls down the ListBox using the scrollbar and double clicks item 'Test 100'
ListBox is updated, however the selection is incorrect. 'Test 86' is selected which is in the position of the previous selection 'Test 100', which is placed at the bottom of the view.
Here's a download link for the example workbook
I'm hoping someone will be able to shine some light on an elegant solution to correct this behaviour!
I have tried programmatically making the selection after the RowSource update, however this has no effect. By adding a brief pause and calling DoEvents (commented in the example) I've been able to make this work to some extent, however I have found that it doesn't work all the time and I would prefer not to have to force a pause as this as it makes the ListBox feel less responsive in my original project.
Private selection As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
selection = ListBox1.ListIndex
Call update
End Sub
Private Sub UserForm_Initialize()
Call update
End Sub
Sub update()
With Sheets("Test")
ListBox1.RowSource = .Range("A2:A" & .Range("A99999").End(xlUp).Row - 1).Address(, , , True)
End With
'Sleep 300
'DoEvents
ListBox1.ListIndex = selection
End Sub
Because it is a timing issue, I think either delays or timers will be required for a solution. This isn't a terribly elegant workaround, but seems to work in my limited tests:
UF module:
Option Explicit
Private selection As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
selection = ListBox1.ListIndex
Call update
End Sub
Private Sub UserForm_Initialize()
Call update
End Sub
Sub update()
Dim hwndUF As Long
With Sheets("Test")
ListBox1.RowSource = .Range("A2:A" & .Range("A99999").End(xlUp).Row - 1).Address(, , , True)
End With
If selection <> 0 Then
hwndUF = FindWindow("ThunderDFrame", Me.Caption)
UpdateListIndex hwndUF
End If
End Sub
Public Sub UpdateLBSelection()
ListBox1.ListIndex = selection
End Sub
and then in a normal module:
Option Explicit
Private Declare Function SetTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private hWndTimer As Long
Sub UpdateListIndex(hWnd As Long)
Dim lRet As Long
hWndTimer = hWnd
LockWindowUpdate hWndTimer
lRet = SetTimer(hWndTimer, 0, 100, AddressOf TimerProc)
End Sub
Public Function TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long) As Long
On Error Resume Next
KillTimer hWndTimer, idEvent
UserForm1.UpdateLBSelection
LockWindowUpdate 0&
Userform1.Repaint
End Function
use
Private selection As Variant '<~~ use a Variant to store the ListBox current Value
'...
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
selection = ListBox1.Value '<~~ store the ListBox current Value
Call update '<~~ this will change the ListBox "RowSource"
ListBox1.Value = selection '<~~ get back the stored ListBox value selected before 'update' call
End Sub
I know that this is ancient now, but I had the same problem a couple of months ago and just stumbled on the solution (to my problem) of not selecting the right item in a listbox.
It turned out to be that the zoom level of the sheet was causing an accuracy issue. Listboxes sometimes look slightly fuzzy when at certain zoom levels - maybe thats just me - anyway, the solution was just to zoom in/out a point that didnt cause the problem.
Thanks
R
I also ran into this problem and a simple adding of Userform.Repaint before the setting the ListBox selection did the trick ......

VBA Power Point equivilant of xlveryhidden

Power Point 2016
I want to hide a shape, but I don't want the user to be able to unhide it except for programmatically essentially
shape.visible = xlVeryHidden
It is possible to do this programmatically using PowerPoint events to detect the selection of your 'marked' shape, hide it and then unselect it. I have used this mechanism in several of my PowerPoint add-in products before and it works very well. It requires the following elements:
VBA code in class module for PowerPoint app events
VBA code in standard module
Initialisation of app events via the ribbon onLoad callback
Identification mechanism for the shape(s) you want to hide. Tags work best but you could also use the simpler .Name property
Use of Win API timer to trigger a check for shapes unhidden using the Selection Pane
Solution code contained within either a macro-enabled PowerPoint file (.pptm, .potm, .ppsm) or a PowerPoint application add-in (.ppam)
Here is tested code: (not production quality, for example, doesn't handle non-slide views)
In a class module called "clsAppEvents":
' Source code provided by youpresent.co.uk
Option Explicit
Public WithEvents App As Application
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
Debug.Print "Event : App_WindowSelectionChange"
If Sel.Type = ppSelectionShapes Then CheckSelection
End Sub
Private Sub App_PresentationClose(ByVal Pres As Presentation)
StopTimer
End Sub
In a standard module called "Main":
' Source code provided by youpresent.co.uk
Option Explicit
'Create a new event handler object from the event class
Public oEH As New clsAppEvents
' Ribbon callback to initialise PowerPoint events
Public Sub OnLoadRibbon(ribbon As IRibbonUI)
Set oEH.App = Application
Debug.Print "PowerPoint App Events Initialised"
StartTimer
End Sub
' Timer initiated check to see if Very Hidden shapes have been unhidden using the Selection Pane
Public Sub CheckShapes()
Dim lCurSlide As Long
Dim oShp As Shape
Dim bFound As Boolean
lCurSlide = ActiveWindow.View.Slide.SlideIndex
For Each oShp In ActivePresentation.Slides(lCurSlide).Shapes
If oShp.Name = "VeryHidden" Then oShp.Visible = msoFalse
Next
End Sub
' Selection change event initialised check to see if selection is Very Hidden
Public Sub CheckSelection()
Dim oShp As Shape
Dim bFound As Boolean
StopTimer
For Each oShp In ActiveWindow.Selection.ShapeRange
If oShp.Name = "VeryHidden" Then
oShp.Visible = msoFalse
bFound = True
End If
Next
If bFound Then ActiveWindow.Selection.Unselect
StartTimer
End Sub
In a standard module called "WinTimer":
' Source code provided by youpresent.co.uk
Option Explicit
Public TimerID As Long
Public TimerCycles As Long
' Source : https://support.microsoft.com/kb/180736?wa=wsignin1.0
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As LongPtr, _
ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr) As LongPtr
#Else
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
#End If
' Starts the time with uElapse time-out period in milliseconds
Public Function StartTimer()
TimerID = SetTimer(0, 0, 100, AddressOf TimerProc)
If TimerID = 0 Then Debug.Print "Timer not created.": Exit Function
Debug.Print "Timer " & TimerID & " started at : " & Now
End Function
Private Function TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
TimerCycles = TimerCycles + 1
If TimerCycles Mod 10 = 0 Then Debug.Print "Timer " & TimerID & " running : " & TimerCycles
CheckShapes
End Function
Public Function StopTimer()
Dim tmpTimerID As Long
tmpTimerID = TimerID
' If the KillTimer function succeeds, the return value is nonzero.
' If the KillTimer function fails, the return value is zero.
TimerID = KillTimer(0, TimerID)
If TimerID = 0 Then
Debug.Print "Couldn't kill the timer"
Else
Debug.Print "Timer " & tmpTimerID & " stopped at : " & Now & " with " & TimerCycles & " cycles"
End If
TimerCycles = 0
TimerID = 0
End Function
And finally, add this ribbon XML to the macro-enabled pptm/ppam/ppsm/potm file:
<customUI onLoad="OnLoadRibbon" xmlns="http://schemas.microsoft.com/office/2006/01/customui"/>
Now, if you open the macro-enabled file and add a shape to any slide with a name "VeryHidden" you shouldn't be able to unhide it via the PowerPoint UI. Of course, tags should be used instead of names but this is just to prove the concept.
There is no such equivalent in PowerPoint. Any hidden shape can be made visible from the selection pane.

Copying text to clipboard using VBA

In MS Excel 2010 I am trying to copy some text to the clipboard using SendKeys. However, it does not work.
Is this some kind of security measure that Microsoft took in order to prevent people from creating fraudulent macros? Here's some code that shows what I'm trying to do (assume, that you're in the vba window and have some text selected):
Public Sub CopyToClipboardAndPrint()
Call SendKeys("^(C)", True)
Dim Clip As MSForms.DataObject
Set Clip = New MSForms.DataObject
Clip.GetFromClipboard
Debug.Print Clip.GetText
End Sub
Note that in order to use the MSForms.DataObject you'll have to reference %windir%\system32\FM20.DLL (i.e. Microsoft Forms 2.0 Object Library).
Edit:
The text I'm trying to copy is not in the document window, but in the immediate window of the vba project window! So Selection.Copy won't work here.
The following code uses the SendInput function from the Windows API to simulate the Control-C key combination, in order to copy the current text selection to the Clipboard.
The copy/print subroutine (the very last procedure in the code) calls two utility functions to trigger the necessary key presses and then uses the code you prepared to retrieve the text from the Clipboard.
I've tested the code in the Immediate window, the code editor pane, and the worksheet.
Option Explicit
'adapted from:
' http://www.mrexcel.com/forum/excel-questions/411552-sendinput-visual-basic-applications.html
Const VK_CONTROL = 17 'keycode for Control key
Const VK_C = 67 'keycode for "C"
Const KEYEVENTF_KEYUP = &H2
Const INPUT_KEYBOARD = 1
Private Type KEYBDINPUT
wVK As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
End Type
Private Type GENERALINPUT
dwType As Long
xi(0 To 23) As Byte
End Type
Private Declare Function SendInput Lib "user32.dll" _
(ByVal nInputs As Long, _
pInputs As GENERALINPUT, _
ByVal cbSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)
Private Sub KeyDown(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVK = bKey
KInput.dwFlags = 0
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
Call SendInput(1, GInput(0), Len(GInput(0)))
End Sub
Private Sub KeyUp(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVK = bKey
KInput.dwFlags = KEYEVENTF_KEYUP
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
Call SendInput(1, GInput(0), Len(GInput(0)))
End Sub
Sub CopyToClipboardAndPrint()
Dim str As String
'Simulate control-C to copy selection to clipboard
KeyDown VK_CONTROL
KeyDown VK_C
KeyUp VK_C
KeyUp VK_CONTROL
DoEvents
Dim Clip As MSForms.DataObject
Set Clip = New MSForms.DataObject
Clip.GetFromClipboard
Debug.Print Clip.GetText
End Sub

Passing value to excel inputbox from VB.NET

I am trying to automate data population on some excel sheets that have some macros. Now the excel is protected and I cannot get the secret key. Now I am able to run the macros but when I try to pass arguments I get arguments mismatch.
If I just run the macro with the name, I get an inputbox which takes an extra argument as input and auto generates some of the values for the columns. I have to manually enter this value into the inputbox as of now. Is there any way that I could automate that process, i.e capture the inputbox thrown by the macro in the vb.net script and enter the values from there? i.e., I would like to run the macro and after I get the popup asking me to enter some value, use the vb.net code to enter the value to that popup.
Here is what I have till now
Public Class Form1
Dim excelApp As New Excel.Application
Dim excelWorkbook As Excel.Workbook
Dim excelWorkSheet As Excel.Worksheet
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
excelWorkbook = excelApp.Workbooks.Open("D:/excelSheets/plan_management_data_templates_network.xls")
excelApp.Visible = True
excelWorkSheet = excelWorkbook.Sheets("Networks")
With excelWorkSheet
.Range("B7").Value = "AR"
End With
excelApp.Run("createNetworks")
// now here I would like to enter the value into the createNetworks Popup box
excelApp.Quit()
releaseObject(excelApp)
releaseObject(excelWorkbook)
End Sub
Macro definition
createNetworks()
//does so basic comparisons on existing populated fields
//if true prompts an inputbox and waits for user input.
This stall my vb.net script too from moving to the next line.
Like you and me, we both have names, similarly windows have handles(hWnd), Class etc. Once you know what that hWnd is, it is easier to interact with that window.
This is the screenshot of the InputBox
Logic:
Find the Handle of the InputBox using FindWindow and the caption of the Input Box which is Create Network IDs
Once that is found, find the handle of the Edit Box in that window using FindWindowEx
Once the handle of the Edit Box is found, simply use SendMessage to write to it.
In the below example we would be writing It is possible to Interact with InputBox from VB.Net to the Excel Inputbox.
Code:
Create a Form and add a button to it.
Paste this code
Imports System.Runtime.InteropServices
Imports System.Text
Public Class Form1
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
ByVal lParam As String) As Integer
Const WM_SETTEXT = &HC
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim Ret As Integer, ChildRet As Integer
'~~> String we want to write to Input Box
Dim sMsg As String = "It is possible to Interact with InputBox from VB.Net"
'~~> Get the handle of the "Input Box" Window
Ret = FindWindow(vbNullString, "Create Network IDs")
If Ret <> 0 Then
'MessageBox.Show("Input Box Window Found")
'~~> Get the handle of the Text Area "Window"
ChildRet = FindWindowEx(Ret, 0, "EDTBX", vbNullString)
'~~> Check if we found it or not
If ChildRet <> 0 Then
'MessageBox.Show("Text Area Window Found")
SendMess(sMsg, ChildRet)
End If
End If
End Sub
Sub SendMess(ByVal Message As String, ByVal hwnd As Long)
Call SendMessage(hwnd, WM_SETTEXT, False, Message)
End Sub
End Class
ScreenShot
When you run the code this is what you get
EDIT (Based on further request of automating the OK/Cancel in Chat)
AUTOMATING THE OK/CANCEL BUTTONS OF INPUTBOX
Ok here is an interesting fact.
You can call the InputBox function two ways in Excel
Sub Sample1()
Dim Ret
Ret = Application.InputBox("Called Via Application.InputBox", "Sample Title")
End Sub
and
Sub Sample2()
Dim Ret
Ret = InputBox("Called Via InputBox", "Sample Title")
End Sub
In your case the first way is used and unfortunately, The OK and CANCEL buttons do not have a handle so unfortunately, you will have to use SendKeys (Ouch!!!) to interact with it. Had you Inbutbox been generated via the second method then we could have automated the OK and CANCEL buttons easily :)
Additional Info:
Tested on Visual Studio 2010 Ultimate (64 bit) / Excel 2010 (32 bit)
Inspired by your question, I actually wrote a blog Article on how to interact with the OK button on InputBox.
Currently, I employ a method where I run a thread before the macro is called by the script. The thread checks if the inputbox has been called. If it is, it picks up the value from the location and using sendkeys, submits the box.
This is a rudimentary solution but I was hoping for a more elegant solution to this problem.
My solution Code:
Public Class Form1
Dim excelApp As New Excel.Application
Dim excelWorkbook As Excel.Workbook
Dim excelWorkSheet As Excel.Worksheet
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
excelWorkbook = excelApp.Workbooks.Open("D:/excelSheets/some_excel.xls")
excelApp.Visible = True
excelWorkSheet = excelWorkbook.Sheets("SheetName")
With excelWorkSheet
.Range("B7").Value = "Value"
End With
Dim trd = New Thread(Sub() Me.SendInputs("ValueForInputBox"))
trd.IsBackground = True
trd.Start()
excelApp.Run("macroName")
trd.Join()
releaseObject(trd)
excelApp.Quit()
releaseObject(excelApp)
releaseObject(excelWorkbook)
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
Private Sub SendInputs(ByVal noOfIds As String)
Thread.Sleep(100)
SendKeys.SendWait(noOfIds)
SendKeys.SendWait("{ENTER}")
SendKeys.SendWait("{ENTER}")
End Sub

Trying to write a simply program in VB that will check the system for a timevalue(now) and if its midnight then it increments a number

I'm interested in creating a slide with powerpoint that will just display a new number in a Shape if theres a new day or time (midnight). I know java programming but haven't done programming in over 6 years now. I've never really used VB.
Dim CurrentTime = TimeValue(now)
Sub If CurrentTime.Now = TimeValue(24:00:00)
Then updateNum;
i = i+1
'Then I would like to display 'i' in a shape on powerpoint.
End Sub
Was thinking about doing a continous loop since the file will always be open and will never close.
Or Should I use a timer to countdown the seconds of the day then increment the number?
Unlike Excel, PowerPoint doesn't have OnTimer which would be helpful here.
Just making a loop will result in 100% processor consumption. You probably don't want that.
Calling Sleep() on each iteration will preserve processor time, but make the application unresponsible. That you probably don't want either.
So you should really set up a timer. If writing a VSTO addin is okay with you, then just use the Timer class, otherwise make one yourself in VBA:
Option Explicit
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private hTimer As Long
Private PrevDate As Date
Public Sub StartTimer()
If hTimer = 0 Then
hTimer = SetTimer(0, 0, 1000, AddressOf TimerProc)
End If
End Sub
Public Sub StopTimer()
KillTimer 0, hTimer
hTimer = 0
End Sub
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTime As Long)
Dim CurDate As Date
CurDate = Date
If CurDate > PrevDate Then
PrevDate = CurDate
'Put your display code here
End If
End Sub
You can include this in a module in your presentation. It will fire on every slide change during a slide show:
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
MsgBox (SSW.View.Slide.SlideIndex)
End Sub
Obviously, replace the MsgBox statement with code to update your text with the current date/time.
This works in PPT 2010 and should work as far back as Office 97, but isn't documented/supported, so MS might remove it whenever the whim strikes them. I don't know whether it works in PPT on the Mac.