How to get a label caption to be set in VBA? - vba

This is my first time with creating a UserForm.
I've looked for solutions, but as yet have not found one that works.
I am trying to set the caption for a couple of labels. I want them set when the form opens.
I have this right now(In the UserForms code:
Private Sub Budget_Initialize()
Me.Label25.Caption = Format(Month(Now), "mmmm")
Me.Label26.Caption = Format(Month(Now) + 1, "mmmm")
Me.Caption = "Test, Test, Test!"
Me.Repaint
End Sub
But it doesn't work.
I tried this too(In the ThisWorkbook code):
Private Sub Workbook_Open()
Budget.Show
With Budget
.Label25.Caption = Format(Month(Now), "mmmm")
.Label26.Caption = Format(Month(Now) + 1, "mmmm")
.Caption = "Test, Test, Test!"
End With
Budget.Repaint
End Sub
It opens the UserForm when I open the workbook, but it doesn't update the captions.
I want the captions to be the names of this month and next month.
What am I doing wrong?

The event routine you need (independent of the name of the form)
Private Sub UserForm_Initialize()
....
End Sub
So basically, just rename Budget_Initialize() to UserForm_Initialize()

Format(Month(Now), "mmmm") will always be January, as it is maximally Format(12, "mmmm"). Skip month, Now alone is what you need.

Related

Application.OnTime stops firing after changing the active document

I am trying to implement an autosave function for all documents created from a certain template. In this template I have created the following for tests:
Dim doc As Document
Dim count As Integer
Private Sub Document_Open()
count = 1
Set doc = ActiveDocument
SaveTime
End Sub
Sub SaveTime()
Application.OnTime When:=Now + TimeValue("00:00:15"), _
name:="DoSave"
End Sub
Sub DoSave()
doc.SaveAs2 "c:\test\testsave" & count & ".docx"
count = count + 1
SaveTime
End Sub
Now if I open a document thats created by this template the autosaving works every 15 seconds as intended (15sec + the counter with different name is just for testing).
BUT as soon as I create a new document in Word or open another file the autosaving in the first document stops working and also doesnt come back if I continue to work in the document.
How can I make the autosave work no matter of which document is active? Like this the feature would only work if only one Document is open at a time, which I can not garantuee of course.
Shot in the dark here, but you are dimming doc within the scope of the module (from what I can tell). It is possible that opening the new document causes this to go out of scope. It would be best to just pass the document between routines.
Something like this:
' This will declare count within the scope of the module
Private count As Integer
Private Sub Document_Open()
count = 1
SaveTime ActiveDocument
End Sub
Sub SaveTime(doc as Document)
Application.OnTime When:=Now + TimeValue("00:00:15"), "'DoSave doc'"
End Sub
Sub DoSave(doc as Document)
doc.SaveAs2 "c:\test\testsave" & count & ".docx"
count = count + 1
SaveTime
End Sub
I haven't used OnTime much, so if the syntax above doesnt allow arguments to be passed, here is a version using a Private doc variable.
' This will declare count and doc within the scope of the module
Private count As Integer
Private doc as Document
Private Sub Document_Open()
count = 1
SaveTime
End Sub
Sub SaveTime()
Application.OnTime When:=Now + TimeValue("00:00:15"), "DoSave"
End Sub
Sub DoSave()
doc.SaveAs2 "c:\test\testsave" & count & ".docx"
count = count + 1
SaveTime
End Sub
I hope this helps. I mostly work within Excel for VBA so I apologize if I am way off the mark here.
EDIT:
I figured it out. What is happening is every time your save event fires it is saving the active document as a new file, but it is not creating a new instance. For example, if test is your first document then:
Test Opens > Event Fires > Test becomes Test2.docx ( Event Fires > Test2 becomes Test3 etc.
Since the code is still stored in memory somehow (this is the part I dont fully understand, but it is, from what I can tell, is what's happening) the event still fires. The problem is, opening a new document somehow refreshes this and the event cancels.
There is a simple workaround, see below:
Option Explicit
Private doc As Document
Private count As Integer
Private Sub Document_Open()
count = 1
Set doc = ActiveDocument
SaveTime
End Sub
Sub SaveTime()
Application.OnTime Now + TimeValue("00:00:15"), "DoSave"
End Sub
Sub DoSave()
doc.Save
Application.Documents.Add doc.FullName
ActiveDocument.SaveAs2 "c:\test\testsave" & count & ".docx"
ActiveDocument.Close
count = count + 1
SaveTime
End Sub
This creates a new instance of the document, saves this new instance, and then closes it. This leaves the old instance in-tact and running.
I hope that all makes sense. Admittedly, I am not clear on why the code remains in memory even when the document holding the code no longer exists.

If statement to paste values in VBA

I am NEW to VBA and need some help. I am trying to write something that will look in my sheet named 'ROLLUP' and if cell H5 contains the letters "jan", then I would like to paste the values from sheet named 'Project" cells I97:I102 in sheet named "Detail" cells H38:H43. The following is my code and nothing happens. Any help?
Option Explicit
Private Sub ETC_pop()
month = Worksheets("ROLLUP").Range("H5")
If ws.Name = "Detail" Then
If InStr(month, ("Jan")) > 0 Then
Worksheets("Detail").Range("H38:H43").Value = Worksheets("Project").Range("I97:I102").Value
End If
End If
End Sub
You can make this one If-statement with two parts
Private Sub ETC_pop()
If Sheets("ROLLUP").Range("H5").Text="Jan" Then
Sheets("Detail").Range("H38:H43").Copy
Sheets("Project").Range("I97:I102").PasteSpecial xlPasteValues
End If
End Sub
Edit:
To account for H5 containing a date, we want to use MONTH() function such as:
Private Sub ETC_pop()
If Month(Sheets("ROLLUP").Range("H5"))=1 Then
Sheets("Detail").Range("H38:H43").Copy
Sheets("Project").Range("I97:I102").PasteSpecial xlPasteValues
End If
End Sub
It's better not to use a variable Month which is similar to the function, but to use a distinct name, like myMonth.
Other notes are inside the code (as comments).
Option Explicit
Private Sub ETC_pop()
Dim myMonth As String
myMonth = Worksheets("ROLLUP").Range("H5")
'If ws.Name = "Detail" Then '< -- not needed according to your post
' another option >> use if Case In-sensitive
' If UCASE(myMonth) Like "*JAN*" Then
If myMonth Like "*jan*" Then
Worksheets("Detail").Range("H38:H43").Value = Worksheets("Project").Range("I97:I102").Value
End If
'End If
End Sub

Excel Add-in with some info stored

I have created a UserForm1 in Excel and saved it as an add-in. This add-in works fine but it does not store some data that I need (does not store it in itself not in the opened excel). I have to store some information in cells A1 and A2 (in A1 Username, in A2 today's date).
When I run this add-in the UserForm1 does not contain these values.
Is there a way how I can store the UserName and get the updated date?
Here is the code for UserForm1:
Private Sub UserForm1_Initialize()
Me.DocumentName.Text = ActiveWorkbook.FullName
DocumentName.Visible = False
TextBoxDate.Value = Worksheets("Sheet1").Cells(2, "A").Value
TextBoxDate.Value = CDate(TextBoxDate.Value)
UserName.Visible = False
Userform1.UserName.Text = CStr(Range("A1").Value)
'If A1 is empty pops up a UserRegister form
If UserName = "" Then
UserRegister.Show
End If
End Sub
UserRegister form code:
Private Sub UserName_Change()
Sheets("Sheet1").Range("A1") = UserName.Text
End Sub
' I want to store the UserName, so the user does not have to enter it every single time
Private Sub CommandButtonGO_Click()
ThisWorkbook.Save
Unload Me
End Sub
To get the date I just use the formula =TODAY() in Cell A2. I know there are other ways, but I found this one very simple.
Can you try this?
UserForm UserForm1:
Private Sub UserForm1_Initialize()
Me.DocumentName.Text = ActiveWorkbook.FullName
DocumentName.Visible = False
TextBoxDate.Value = ThisWorkbook.Worksheets("Sheet1").Range("A2").Value
'TextBoxDate.Value = CDate(TextBoxDate.Value)
UserName.Visible = False
UserForm1.UserName.Text = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value
'If A1 is empty pops up a UserRegister form
If Len(UserName.Text) = 0 Then
UserRegister.Show
End If
Debug.Print "Name: " & ThisWorkbook.Worksheets("Sheet1").Range("A1").Value
Debug.Print "Date: " & ThisWorkbook.Worksheets("Sheet1").Range("A2").Value
End Sub
UserForm UserRegister:
Private Sub UserName_Change()
CommandButtonGO.Enabled = Not (UserName.Text = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value)
End Sub
' I want to store the UserName, so the user does not have to enter it every single time
Private Sub CommandButtonGO_Click()
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value = Trim(UserName.Text)
ThisWorkbook.Worksheets("Sheet1").Range("A2").Value = Now
ThisWorkbook.Save
Unload Me
End Sub
Private Sub UserRegister_Initialize()
UserName.Text = UCase(Environ("USERNAME"))
End Sub
Well, I figured out how I can do it.
To get a user name i used a code from here : Getting computer name using VBA (It also says how to get User Name there)
To get current date of entry I just changed the code for output to:
ActiveCell.Offset(1, 0).Select 'Date column A
ActiveCell.Value = Date
And it outputs the current date in my LOGfile excel.
Thanks a lot for your help =)

Formatting dates in a combobox dropdown list

I have created a simple userform with a combobox populated with a range of dates (rngWeekList) but I am having serious headaches trying to get the list in the dropdown box to appear in "dd-mmm-yy" format. Here is my code:
Private Sub UserForm_Initialize()
' Populate the list with the date range
ComboBox1.List = Worksheets("Cover").Range("rngWeekList").Value
' Set the defulat selection (based off rngWeekIndex)
ComboBox1.ListIndex = Worksheets("Cover").Range("rngWeekIndex").Value - 1
' Format
ComboBox1 = Format(ComboBox1, "dd-mmm-yy")
End Sub
Private Sub ComboBox1_Change()
' Format
ComboBox1 = Format(ComboBox1, "dd-mmm-yy")
End Sub
This manages to format the selected item in the combobox correctly (e.g. "02-Jul-14") but when I open the dropdown list, all the list entries shown are formatted in the default "m/d/yyyy". Is there a way to change the formatting for the list entries? It is confusing for users who are used to seeing the day before the month.
Thanks in advance for your help, it is much appreciated.
Ed
I managed to fix it by looping through each item in the comboboax and formatting it (feel free to correct me if there is a more elegant way to do it!)
Private Sub UserForm_Initialize()
Dim i As Integer
' Populate the list with the date range
ComboBox1.List = Worksheets("Cover").Range("rngWeekList").Value
'Format all items
For i = 0 To ComboBox1.ListCount - 1
ComboBox1.List(i) = Format(DateValue(ComboBox1.List(i)), "dd-mmm-yy")
Next i
' Set the default selection (based off rngWeekIndex)
ComboBox1.ListIndex = Worksheets("Cover").Range("rngWeekIndex").Value - 1
End Sub
Private Sub ComboBox1_Change()
' Format the selection
ComboBox1 = Format(ComboBox1, "dd-mmm-yy")
End Sub
Sorry for posting, but I really thought I was stuck.
Thanks again,
Ed

Change one letter color in VB Ms Word 2007

I'm new in Visual basic and I would like to approach something simple.
I have button and TextBox
When I click the button I want to display some string in the textbox, but some particular characters into that string to be in some particular color.
Button:
Private Sub CommandButton1_Click()
TextBox1.Text = "Hi my name is Koki"
End Sub
TextBox:
Private Sub TextBox1_Change()
End Sub
Output:
Note: It will help me even if there is a static solution, something like <span></span> in Html
While dealing with VBA you have to consider ranges and then properties of the given ranges. Here you have a sample code doing what you want:
Private Sub CommandButton1_Click()
Set Object = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=80, Height:=80)
With Object.TextFrame.TextRange
.Text = "Hi my name is Koki"
With .Characters(2).Font
.ColorIndex = wdTurquoise 'http://msdn.microsoft.com/en-us/library/office/aa195611(v=office.11).aspx
End With
With .Characters(12).Font
.ColorIndex = wdTurquoise
End With
With .Characters(18).Font
.ColorIndex = wdTurquoise
End With
End With
End Sub
As you can see, I am adding the textbox at the start. I am doing this to make sure that you use the right textBox (if you add an ActiveX textbox the behaviour would be different).
---------- UPDATE
In order to rely on the proposed methodology, you might have to use the Document Open event to delete any shape and write the ones you want. For example:
Private Sub Document_Open()
For i = ActiveDocument.Shapes.Count To 1 Step -1
ActiveDocument.Shapes(i).Delete
Next i
Set Object = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=80, Height:=80)
End Sub
This code will be called when the document is opened and will delete all the shapes you created (not the ActiveX objects, like the commandButton) and add the textbox. You can declare the Object variable globally and access it from anywhere in the code (CommandButton1_Click(), for example).
Bear in mind that this is an example of a workaround to get what you want. You don't need to delete the given shapes, you can just take this code to check what to do at the start of the document: if there is a shape called "the name I want", let it there and don't do anything, just set it to the global Object variable, that is:
Private Sub Document_Open()
For i = ActiveDocument.Shapes.Count To 1 Step -1
If(ActiveDocument.Shapes(i).Name = "the name I want") Then
Set Object = ActiveDocument.Shapes(i)
Exit Sub
End If
Next i
Set Object = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=80, Height:=80)
End Sub