I've never coded in my life and today is my first day I've got somewhere with it however I was wondering if someone could fill in the missing code so I can get my program to refresh ever 1 second. the point of the software is to show a a message to tell my when my SSD is low on space id like to to run in the background and refresh all the time the code looks like this:
Public Class Form1
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Opacity = 0
Me.Visible = False
If Microsoft.VisualBasic.Left(My.Computer.FileSystem.GetDriveInfo("C:\").TotalFreeSpace / 1024 / 1024 / 1024, 2) < 48 Then
Form2.Show()
End If
'MsgBox(My.Computer.FileSystem.GetDriveInfo("C:\").TotalFreeSpace)
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Timer1.Enabled = True
Timer1.Interval = 1000
End Sub
End Class
if someone could help me id be ever so greateful bare in mind I literally know nothing about visual basic.
Once you have declared the timer value, you must add the code to the timer function:
Private Sub Timer1_Timer()
Rem put display code here..
End Sub
Related
I'm working with some external Excel VBA libraries that perform asynchronous operations, and I'm wondering if there's a way of pausing code execution until some event has fired (as an alternative to just busy-waiting, which is what I'm currently doing)
Say you've got two class modules, AsyncClassModule
Public Event ExampleEvent()
Public Sub DoSomethingAsynchronous()
'Some operation would run here, then fire the event when complete
'In the real case I'm working with, this is an external library I can't control
RaiseEvent ExampleEvent
End Sub
And CallerClassModule
Private WithEvents x As AsyncClassModule
Private Sub Class_Initialize()
Set x = New AsyncClassModule
x.DoSomethingAsynchronous
'This is the issue; need to somehow wait for asynchronous operation to complete before proceeding
MsgBox "All done!"
End Sub
What I'd like to do is, after calling DoSomethingAsynchronous, pause code execution until ExampleEvent has fired. Currently, I'm just busy-waiting, like this:
Private WithEvents x As AsyncClassModule
Private asyncOperationComplete As Boolean
Private Sub Class_Initialize()
Set x = New AsyncClassModule
asyncOperationComplete = False
x.DoSomethingAsynchronous
While Not asyncOperationComplete
DoEvents
Sleep 1000
Wend
MsgBox "All done!"
End Sub
Private Sub x_ExampleEvent()
asyncOperationComplete = True
End Sub
Are there any alternatives to looping in this situation, which won't take up CPU time while waiting? In pseudo-code, ideally I'd like something like this:
x.DoSomethingAsynchronous
Pause until x.ExampleEvent fires
MsgBox "All done!"
Update:
It seems Visio and Excel on my PC do not use the same Office Object Libraries, at least that is what a look at the used references tells me. Visio uses 15.0, Excel uses 16.0, we use different subscriptions for both, Excel is part of the MS office 365 ProPlus Package, Visio is separate.
I tested it on a PC with a current subscription of Visio with the 16.0 Office Object Libraries. This time closing the Userform did not cause a crash. So I guess the problem was with the old version. If anybody has the ability to cross check this and test the code in a Excel 15.0 installation that would be great.
Original Post
I have been using an Observer Implementation in VBA to create some "better" UserForms that implement an Interface.
The solution works great as far as I'm concerned, but there is one minor problem:
Whenever I close the UserForm by pressing the FormControlMenu Close Control (the red X in the top/right corner) my application crashes with a "Out of Stack Space Error".
Crashing occurs in the following way: I get the Message box with the error (standart VBA), when I close it there seems nothing amiss, but as soon as I try to run another piece of code (any) Visio will crash to the Desktop.
Now the strange part: I actually catch the vbQueryClose event, cancel it and run my own closing routine which only hides the userform. When closing (hiding) the UserForm via a commandButton the same way (me.hide), the error does not occur.
This happens only in Visio, the exact same code causes no error/crashing in Excel!
I hope someone with some more knowledge on the whole Reference/Object/COM-Business can shed some light into this
The Code:
Code also available as zipped file (no Excel/Visio Files, just the exported modules) so you don't have to copy/paste and create UserForms: https://www.dropbox.com/s/ziqjv2umcy3co5t/ObserverExample.zip?dl=0
The actual Observer Implementation is a bit longer, but this code is the minimal verifiable example.
Module1 (Module):
'#Folder("ObserverTest")
Option Explicit
Sub StartTest()
With New Foo
.Test
End With
End Sub
Foo (Class):
'#Folder("ObserverTest")
Option Explicit
Private WithEvents myObs As Observer
Private myView As IBar
Public Sub Test()
Set myView = New Bar
Dim myViewAsObservable As IObservable
Set myViewAsObservable = myView
myViewAsObservable.AddObserver myObs
Set myViewAsObservable = Nothing
myView.Show
Debug.Print myView.howClosed
End Sub
Private Sub Class_Initialize()
Set myObs = New Observer
End Sub
Private Sub Class_Terminate()
Set myObs = Nothing
End Sub
Private Sub myObs_Notify(source As Object, arg As Variant)
If VarType(arg) = vbString Then
Debug.Print arg
End If
End Sub
IBar (Class)
'#Folder("ObserverTest")
Option Explicit
Public Sub Show(): End Sub
Public Property Get howClosed() As String: End Property
IObservable(Class)
'#Folder("ObserverTest")
Option Explicit
Public Sub AddObserver(ByVal obs As Observer): End Sub
Bar (UserForm)
'#Folder("ObserverTest")
Option Explicit
Implements IBar
Implements IObservable
Private obsCol As Collection
Private cancelHow As String
'---IBar Stuff
Private Sub IBar_Show()
Me.Show
End Sub
Private Property Get IBar_howClosed() As String
IBar_howClosed = cancelHow
End Property
'--- Closing Stuff
Private Sub btCancel_Click()
cancelHow = "Closed by pressing the >Cancel< Button"
onCancel
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = VbQueryClose.vbFormControlMenu Then
Cancel = True
cancelHow = "Closed by pressing the >X< Control"
onCancel
End If
End Sub
Private Sub onCancel()
Me.hide
End Sub
'---Observer Stuff
Private Sub UserForm_Initialize()
Set obsCol = New Collection
End Sub
Private Sub UserForm_Terminate()
Set obsCol = Nothing
End Sub
Private Sub tbTest_Change()
Notify Me.tbTest.Text
End Sub
Private Sub IObservable_AddObserver(ByVal obs As Observer)
obsCol.Add obs
End Sub
Private Sub Notify(ByVal arg As Variant)
Dim obs As Observer
For Each obs In obsCol
obs.Notify Me, arg
Next obs
End Sub
Observer (Class)
'#Folder("ObserverTest")
Option Explicit
Public Event Notify(source As Object, arg As Variant)
Public Sub Notify(ByVal source As Object, ByVal arg As Variant)
RaiseEvent Notify(source, arg)
End Sub
The Problem lay apparently with the version of the Office Object Library I was using. Using the 16.0(2016) Library instead of the 15.0(2013) solved the problem for me.
If anybody has a good explanation, post it here and I will accept it as answer.
I have a VBA program that opens a series of userforms.
I designed the entire thing on my laptop, and tested it on some other laptops. Both in Excel 2010 and 2016.
I shared it with coworkers who use a different style of laptop (Win7, Office 2010). Every time they hit the button to open the userform they get a Catastrophic Failure, out of memory error.
I've seen online that modules should be under 64kb. The module used to open the button is very small (just opens up UserForm1).
The Userform frm file is 4 KB.
The Userform frx file is 1.24 MB, larger because there are pictures etc. on this form.
The code that the User Form runs.
Private Sub ComboBox1_DropButtonClick()
'Determines the controller model based off selection
If ComboBox1.Text = "VHX-6000 + VHX-A60E" Then
Controller = 6000
Else
Controller = 950
End If
'Updates textbox1 with current pricing info
TextBox1.Text = Application.VLookup(Controller, Sheet3.Range("A37:C45"), 2, 0)
End Sub
Private Sub Continue1_Click()
price = 0
'Determines if it should show the camera page based on the controller selection
If Controller = 6000 Then
CameraForm.Show
Else
Camera = 6020
StageForm.Show
End If
End Sub
Private Sub Image6_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub Label2_Click()
End Sub
Private Sub UserForm_Activate()
'Make Sheet 3 activate to avoid that weird error message towards the end
Worksheets("sheet3").Activate
'Sets the dropdown list
ComboBox1.List() = Sheet3.Range("C6:C7").Value
'Clears the quote information if present
Sheet3.Range("M51:O100").ClearContents
Controller = 0
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
'Full Screen
With Me
.Width = Application.Width
.Height = Application.Height
End With
End Sub
Appreciate this is an old thread but I had a similar problem which has been causing me a headache for a few hours.
I'd been working on dual monitors and set up half a dozen user forms
If I then tried to open some of the user forms on my laptop without any monitors connected I was getting he dramatic, 'catastrophic failure.
I found that the issue was something to do with the screen scale in display settings. My monitors were 100%, with my laptop 125%.
When I changed the laptop to 100%... voila. all working. Bit daft to be honest but thought it worth a mention
Enigma
Not much to go on:
To load the form, I have the code for a Command Button OLE Object in the Sheet3 code window:
Private Sub CommandButton1_Click()
Load ControllerForm
ControllerForm.Show
End Sub
Notice two differences from your code:
Sub Button1_Click()
ControllerForm.Show
End Sub
Do you maybe need to use Load ControllerForm?
There is a difference between those buttons: Commandbutton1 and Button1. Your Button1 is a msoFormControl (8), while my button is a msoOLEControlObject(12).
Look here.
currently i am programming a excel macro. The macro shows a Userform.
In the Userform the User can Select something. After the User has selected something i call Userform.Hide to Hide the Userform and to read the Selection from the Form. After the selection was read i call Unload Userform. Now the Code interacts with the selection. I want to do this in a loop but when the Code trys to show the Userform the second time. I get a exception that the Form is already displayed. I cant understand it, because i called Unload Userform. When i do it in debug mode everthing works as it should.
Userform Code
Private Sub Image1_Click()
SelectCard 1
End Sub
Private Sub Image2_Click()
SelectCard 2
End Sub
Private Sub SelectCard(number As Integer)
SelectedNumber = number
Me.Hide
End Sub
Public Sub CardSelector_Activate(Cards As Cards)
Dim c As card
For Each Key In Cards.CardDictionary.Keys
Set c = Cards.CardDictionary.Items(Key - 1)
If c.value = 1 And c.played Then
Image1.Enabled = False
End If
If c.value = 2 And c.played Then
Image2.Enabled = False
End If
Next Key
number = SelectedNumber
CardSelector.Show
End Sub
Code in the ClassModule i call this in a loop
Sub Costum(Spalte As Integer, Zeile As Integer, SpalteBeginn As Integer, Cards As Cards, CardsOpponent As Cards)
CardSelector.CardSelector_Activate Cards
Dim c As card
Dim number As Integer
number = CardSelector.SelectedNumber
Set c = Cards.CardDictionary.Items(CardSelector.SelectedNumber - 1)
SetCardAsPlaced c, Zeile, Spalte, SpalteBeginn
Unload CardSelector
End Sub
Can someone help me here ?
I am not sure if I fully understand your issue, but this is how I invoke a form using VBA. This is assuming you have a Cancel and OK button:
In the form:
Option Explicit
Private m_ResultCode As VbMsgBoxResult
Private Sub btnCancel_Click()
Call CloseWithResult(vbCancel)
End Sub
Private Sub btnOK_Click()
' Store form control values to member variables here. Then ...
Call CloseWithResult(vbOK)
End Sub
Private Sub CloseWithResult(Value As VbMsgBoxResult)
m_ResultCode = Value
Me.Hide
End Sub
Public Function ShowMe(Optional bNewLayerOptions As Boolean = True) As VbMsgBoxResult
' Set Default to Cancel
m_ResultCode = vbCancel
' Execution will pause here until the form is Closed or Unloaded
Call Me.Show(vbModal)
' Return Result
ShowMe = m_ResultCode
End Function
Then, to call it (please note that frmLayers is my own VBA form object - you would use yours):
Dim dlgLayers As New frmLayers
If (dlgLayers.ShowMe(False) = vbOK) Then
' Proceeed
End If
Does this help you with your issue? I am sorry if I have misunderstood, and I will remove my answer if needed.
Things like xxxxx_Activate etc. are event handlers called by the framework. So, for example, there is an event for activate and an event for initialize. You don't normally have to directly call these yourself if you set your code up correctly. See https://support.microsoft.com/en-us/kb/138819.
I am trying to create a piece of code that links to a certain sheet after a certain amount of time of inactivity, what I mean by inactivity is not switching through sheets, so when somebody is clicking on sheets that counts as activity but as soon as its been on the same sheet for an amount of time I want it to switch to sheet 1 (sheet 1 is linked to a presentation and will act much like a screensaver would)
Here is my code in ThisWorkbook
Private nTime As Date
Const proc As String = "SelectIndex"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Call SetTimer
End Sub
Private Sub SetTimer()
If nTime <> 0 Then
Call Application.OnTime(EarliestTime:=nTime, Procedure:=proc, Schedule:=False)
End If
nTime = Now + TimeValue("00:00:05")
Application.OnTime nTime, Procedure:=proc
End Sub
This works for entering data, when somebody doesn’t enter data for so long it goes to my sheet, but I want it to do it if somebody isn’t switching sheets because nobody has access to enter data anyway, just view the sheets.
It also only works once, when you cancel the presentation and try it again I get the error
"Run time error '1004' Method 'OnTime' of object '_ Application'
Failed "
Just these two problems to overcome and I would really appreciate it if anyone could help J
For information, the procedure SelectIndex is just a macro that switches to sheet 1
If I understand the question correctly, you could trigger the timer within the Sheet_Activate event:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call SetTimer
End Sub