I have created DocVariables in my word template, and am using a UserForm to allow user input to populate these variables.
Here is the code I have been using:
Private Sub CommandButton1_Click()
Dim ReportTitle, reportSub As String
ReportTitle = Me.textBox1.Value
reportSub = Me.textBox2.Value
ActiveDocument.Variables("Report Title").Value = ReportTitle
ActiveDocument.Variables("Sub-Title").Value = reportSub
ActiveDocument.Fields.Update
Me.Repaint
End Sub
This does insert the values from the text boxes into the variables, but it does not update the fields, so I have to manually go to each field and update it.
Can you please tell me where I have gone wrong so that I can fix this issue.
Any and all help is appreciated.
Try:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
With ActiveDocument
.Variables("Report Title").Value = Me.textBox1.Value
.Variables("Sub-Title").Value = Me.TextBox2.Value
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
Me.Repaint
Application.ScreenUpdating = True
End Sub
Related
I have a problem when using VBA for column operation.
I want to select an area in a Word document that contains several paragraphs, and then I want to split them from one column into two.
My VBA code is as follows:
Public Sub testSplitColumn()
Dim targetDoc As Document
Dim sourceFileName As String
sourceFileName = "file path"
Set targetDoc = Documents.Open(sourceFileName, , True)
targetDoc.Paragraphs(503).range.Select
'Splitting column on word
With targetDoc.Paragraphs(503).range.PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
End Sub
It runs, but the result is wrong.
It is columnizing the paragraphs in the entire document, not just the selected paragraphs in the code.
I got a macro code that can achieve the correct effect through the method of word macro recording:
Sub split()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type <> wdPrintView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
With Selection.PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
End Sub
But it's no different from mine.
How can I fix my VBA code?
As #JerryJeremiah said: you need section breaks before and after your selection.
When recording a macro - they will be inserted as well.
I would create a generic sub to insert the section breaks:
Public Sub test_splitTo2Columns()
'your original code
Dim targetDoc As Document
Dim sourceFileName As String
sourceFileName = "file path"
Set targetDoc = Documents.Open(sourceFileName, , True)
'calling the generic function to test with specific paragraph
splitTo2Columns targetDoc.Paragraphs(503).Range
'this will work too - splitting the selected range
splitTo2Columns ActiveDocument.Selection.Range
End Sub
Public Sub splitTo2Columns(rg As Range, Optional fSplitWholeParagraphs As Boolean = True)
Dim rgToSplit As Range
Set rgToSplit = rg.Duplicate
If fSplitWholeParagraphs = True Then
'in case rg = selection and selection is only a single character
rgToSplit.Start = rgToSplit.Paragraphs.First.Range.Start
rgToSplit.End = rgToSplit.Paragraphs.Last.Range.End
End If
insertSectionBreakContinous rgToSplit, wdCollapseStart
insertSectionBreakContinous rgToSplit, wdCollapseEnd
rgToSplit.Start = rgToSplit.Start + 1 'move behind first section break
With rg.PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
End Sub
Private Sub insertSectionBreakContinous(rg As Range, startEnd As WdCollapseDirection)
Dim rgBreak As Range
Set rgBreak = rg.Duplicate
With rgBreak
.Collapse startEnd
.InsertBreak wdSectionBreakContinuous
End With
End Sub
I have a userform which will ask for a number that is then getting looked up in a spreadsheet, saving that range in a variable. When it's found the number, it will hide the first userform and bring up the second one, but in order for me to proceed with the update, I will need to use the same range that I've previously set against my variable in userform1, any idea how to do that? I have declared it as a Public variable but it still doesn't work. Code as it follows:
UserForm1:
Public FillRange As Range
Public BKref As Variant
Private Sub CommandButton1_Click()
On Error GoTo errhndlr:
Set FillRange = Sheets("Loader").Cells.Find(TextRef.Value).Offset(0, 2)
BKref = TextRef.Value
If Not FillRange = "" Then
UserForm1.Hide
UserForm2.Show
Exit Sub
ElseIf FillRange = "" Then
MsgBox "Booking Reference cannot be empty!", vbCritical, "Error: No Booking Ref."
UserForm1.Hide
Exit Sub
Else
MsgBox "Unexpected error, please re-start and try again. If you had this message more than 2 times, please update the line manually.", vbCritical, "Error"
UserForm1.Hide
Exit Sub
End If
Exit Sub
errhndlr:
MsgBox "Booking reference not found, please double-check that the booking reference you've entered is correct, alternatively update it manually.", vbCritical, "Error"
UserFrom1.Hide
End Sub
UserForm2:
Private Sub CommandButton1_Click()
FillRange = TextPloaded.Value
FillRange.Offset(0, 2) = TextTime.Value
FillRange.Offset(0, 3) = TextLoader.Value
If Not TextComm.Value = "" Then
FillRange.Offset(0, 4) = TextComm.Value
ElseIf TextComm.Value = "" Then
FillRange.Offset(0, 4) = ""
End If
If Not FillRange = FillRange(0, -1) Then
MsgBox "Actual and Planned pallets doesn't match, please highlight the diescrepancies on the assembly sheet!"
BKref = FillRange.Offset(0, -2)
Sheets("Assembly").Activate
Sheets("Assembly").Rows(1).AutoFilter Field:=16, Criteria1:=BKref
UserForm2.Hide
Else
UserForm2.Hide
UserForm1.Show
End If
End Sub
If you make use of Option Explicit in every module/userform etc. This forces you to declare all variables properly and shows a message if a variable is not declared.
The issue is that if you declare Public FillRange As Range in Userform1 the variable is only valid in Userform1 but not in Userform2.
So I recommend to decare the variable in a Module instead of Userform1. This way it is accessible everywhere.
Alternative
You can access a public Userform1 variable in Userfrom2 by Userform1.FillRange
Add a property in your first form:
Property Get FillRange() As Range
Set FillRange = Range("A1")
End Property
And read it from your second form:
Dim FillRange
Set FillRange = UserForm1.FillRange
I am trying to create a user form in VBA on Microsoft word.
I have been following http://gregmaxey.com/word_tip_pages/create_employ_userform.html
to create the form.
I am very very very new to programming and have basically just been teaching myself as I go.
I get a "compile error: Sub of Function not defined" when I try and step through Call UF
I've attached the whole code for you to look at and tell me where I've gone wrong, happy for any suggestions.
Module - modMain
Option Explicit
Sub Autonew()
Create_Reset_Variables
Call UF
lbl_Exit:
Exit Sub
End Sub
Sub Create_Reset_Variables()
With ActiveDocument.Variables
.Item("varFormNumber").Value = " "
.Item("varTitle").Value = " "
.Item("varGivenName").Value = " "
.Item("varFamilyName").Value = " "
.Item("varStreet").Value = " "
.Item("varSuburb").Value = " "
.Item("varState ").Value = " "
.Item("varPostCode").Value = " "
.Item("varInterviewDate").Value = " "
End With
myUpdateFields
lbl_Exit:
Exit Sub
End Sub
Sub myUpdateFields()
Dim oStyRng As Word.Range
Dim iLink As Long
iLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each oStyRng In ActiveDocument.StoryRanges
Do
oStyRng.Fields.Update
Set oStyRng = oStyRng.NextStoryRange
Loop Until oStyRng Is Nothing
Next
End Sub
Form - frmLetter13
Option Explicit
Public boolProceed As Boolean
Sub CalUF()
Dim oFrm As frmLetter13
Dim oVars As Word.Variables
Dim strTemp As String
Dim oRng As Word.Range
Dim i As Long
Dim strMultiSel As String
Set oVars = ActiveDocument.Variables
Set oFrm = New frmLetter13
With oFrm
.Show
If .boolProceed Then
oVars("varFormNumber").Value = TextBoxFormNumber
oVars("varTitle").Value = ComboBoxTitle
oVars("varGivenName").Value = TextBoxGivenName
oVars("varFamilyName").Value = TextBoxFamilyName
oVars("varStreet").Value = TextBoxStreet
oVars("varSuburb").Value = TextBoxSuburb
oVars("varState").Value = ComboBoxState
oVars("varPostCode").Value = TextBoxPostCode
oVars("varInterviewDate").Value = TextBoxInterviewDate
End If
Unload oFrm
Set oFrm = Nothing
Set oVars = Nothing
Set oRng = Nothing
lbl_Exit
Exit Sub
End Sub
Private Sub TextBoxFormNumber_Change()
End Sub
Private Sub Userform_Initialize()
With ComboBoxTitle
.AddItem "Mr"
.AddItem "Mrs"
.AddItem "Miss"
.AddItem "Ms"
End With
With ComboBoxState
.AddItem "QLD"
.AddItem "NSW"
.AddItem "ACT"
.AddItem "VIC"
.AddItem "TAS"
.AddItem "SA"
.AddItem "WA"
.AddItem "NT"
End With
lbl_Exit:
Exit Sub
End Sub
Private Sub CommandButtonCancel_Click()
Me.Hide
End Sub
Private Sub CommandButtonClear_Click()
Me.Hide
End Sub
Private Sub CommandButtonOk_Click()
Select Case ""
Case Me.TextBoxFormNumber
MsgBox "Please enter the form number."
Me.TextBoxFormNumber.SetFocus
Exit Sub
Case Me.ComboBoxTitle
MsgBox "Please enter the Applicant's title."
Me.ComboBoxTitle.SetFocus
Exit Sub
Case Me.TextBoxGivenName
MsgBox "Please enter the Applicant's given name."
Me.TextBoxGivenName.SetFocus
Exit Sub
Case Me.TextBoxFamilyName
MsgBox "Please enter the Applicant's family name."
Me.TextBoxFamilyName.SetFocus
Exit Sub
Case Me.TextBoxStreet
MsgBox "Please enter the street address."
Me.TextBoxStreet.SetFocus
Exit Sub
Case Me.TextBoxSuburb
MsgBox "Please enter the suburb."
Me.TextBoxSuburb.SetFocus
Exit Sub
Case Me.ComboBoxState
MsgBox "Please enter the state."
Me.ComboBoxState.SetFocus
Exit Sub
Case Me.TextBoxPostCode
MsgBox "Please enter the postcode."
Me.TextBoxPostCode.SetFocus
Exit Sub
Case Me.TextBoxInterviewDate
MsgBox "Please enter the interview date."
Me.TextBoxInterviewDate.SetFocus
Exit Sub
End Select
'Set value of a public variable declared at the form level.'
Me.boolProceed = True
Me.Hide
lbl_Exit:
Exit Sub
End Sub
There are a couple of issues here.
The first issue is that you do not have a routine named UF for Call UF to call.
The routine that you have named CalUF should not be in the code for the UserForm but should be in modMain and renamed CallUF.
There is no need to include an exit point in your routine as you don't have an error handler.
Your AutoNew routine could be rewritten as:
Sub Autonew()
Create_Reset_Variables
CallUF
End Sub
I have commented your sub myUpdateFields for you.
Sub myUpdateFields()
Dim oStyRng As Word.Range
Dim iLink As Long
iLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
' logically, iLink should be the StoryType of the first header in Section 1
' Why would this be needed in all StoryRanges?
' Anyway, it is never used. Why have it, then?
' This loops through all the StoryRanges
For Each oStyRng In ActiveDocument.StoryRanges
' This also loops through all the StoryRanges
Do
oStyRng.Fields.Update
Set oStyRng = oStyRng.NextStoryRange
Loop Until oStyRng Is Nothing
'And after you have looped through all the StoryRanges
' Here you go back and start all over again.
Next oStyRng End Sub
Frankly, I don't know if the Do loop does anything here. Perhaps it does. Read up about the NextStoryRange property here. I also don't know if using the same object variable in the inside loop upsets the outside loop. I don't know these things because I never needed to know them. Therefore I wonder why you need them on your second day in school.
You are setting a number of document variables. These could be linked to REF fields in your document which you wish to update. I bet your document has only one section, no footnotes and no textboxes with fields in them. Therefore I think that the following code should do all you need, if not more.
Sub myUpdateFields2()
Dim Rng As Word.Range
For Each Rng In ActiveDocument.StoryRanges
Rng.Fields.Update
Next Rng
End Sub
To you, the huge advantage of this code is that you fully understand it. Towards this end I have avoiding using a name like oStyRng (presumably meant to mean "StoryRange Object"). It is true that a Word.Range is an object. It is also true that the procedure assigns a StoryRange type of Range to this variable. But the over-riding truth is that it is a Word.Range and therefore a Range. Code will be easier to read when you call a spade a spade, and not "metal object for digging earth". My preferred variable name for a Word.Range is, therefore, "Rng". But - just saying. By all means, use names for your variables which make reading your code easy for yourself.
Hye there.
I would like to ask for any ideas from anyone here.
I have a lot of checkboxes in a worksheet which I link with a chart in the same worksheet. I would like to make a function which run the same code for each of the checkboxes ( I have 24 check boxes overall) when it is click. If you have any idea or suggestion, do tell me.
Here is the idea of mine for the flow of the code. I just have the same flow of code.
Private Sub CheckBox1_Click()
On Error Resume Next
Sheets("REPORT").Activate
ActiveSheets.ChartObjects("STOCK MOVEMENT GRAPH").Activate
On Error GoTo 0
If CheckBox1.Value = False Then
ActiveChart.SeriesCollection(1).Delete
Else
ActiveChart.SeriesCollection.Add Source:=Sheets("REPORT").Range("B4:AB4")
End If
End Sub
Private Sub CheckBox2_Click()
On Error Resume Next
Sheets("REPORT").Activate
Worksheets("REPORT").ChartObjects("STOCK MOVEMENT GRAPH").Activate
On Error GoTo 0
If CheckBox2.Value = False Then
ActiveChart.SeriesCollection(2).Delete
Else
ActiveChart.SeriesCollection.Add Source:=Sheets("REPORT").Range("B5:AB5"), PlotBy:=xlRows
End If
End Sub
Thanks in advance. Regards.
You can pull out the common code into a standalone Sub:
Sub UpdateChart(rowNum As Long, AddingIt As Boolean)
Dim cht As Chart, s As Series, rng As Range, f, i
Set cht = Sheets("REPORT").ChartObjects("STOCK MOVEMENT GRAPH").Chart
'what's the data range?
Set rng = Sheets("REPORT").Range("B3").Offset(rowNum, 0).Resize(1, 2)
If AddingIt Then
'note: not checking if already added....
cht.SeriesCollection.Add Source:=rng
Else
For i = cht.SeriesCollection.Count To 1 Step -1
Set s = cht.SeriesCollection(i)
f = s.Formula
If InStr(f, rng.Address()) > 0 Then s.Delete
Next i
End If
End Sub
Then your checkbox code reduces to this:
Private Sub CheckBox1_Click()
UpdateChart 1, CheckBox1.Value
End Sub
Private Sub CheckBox2_Click()
UpdateChart 2, CheckBox2.Value
End Sub
'etc....
I'm struggling with some VBA code and the BeforeSave methodology.
I've been all over the forums but can't locate the answer I need, so would love some help please.
My question! On saving I need the code to look at Column H (named Claim USD) of a 'Table' (named Claims) for a number value and then if any of the cells has a value to then look at Column I (named Claim Date) and make sure there is a date in there. I have already data validated column I to only accept date entries.
I have found the code below, and tested it for what it does and it works. I'm just not sure how to incorporate my element. Can anyone offer me some help?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rsave As Range
Dim cell As Range
Set rsave = Sheet2.Range("I8,I500")
For Each cell In rsave
If cell = "" Then
Dim missdata
missdata = MsgBox("missing data", vbOKOnly, "Missing Data")
Cancel = True
cell.Select
Exit For
End If
Next cell
End Sub
I have created a custom Class for validation see here. It is very overkill for what you are trying to do but what it will allow you to do is capture all of the cells with errors and do what you'd like with them. You can download and import the 2 class modules Validator.cls and ValidatorErrors.cls And then use the following
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Unflag
Dim rsave As Range
Dim rcell As Range
Dim v AS New Validator
Set rsave = Sheet2.Range("Table1[Estimate Date]")
with v
For Each rcell In rsave
.validates rcell,rcell.address
.presence
Next rcell
End With
If not(v.is_valid) Then
FlagCollection v.errors
MsgBox("Missing data in " & v.unique_keys.Count & " Cell(s).", vbOKOnly, "Missing Data")
Cancel = True
End IF
Set v = Nothing
End Sub
Public Sub flag(flag As String, comment As String)
Dim comments As String
If has_comments(flag) Then
comments = Sheet2.Range(flag).comment.Text & vbNewLine & comment
Else
comments = comment
End If
Sheet2.Range(flag).Interior.Color = RGB(255, 255, 102)
Sheet2.Range(flag).ClearComments
Sheet2.Range(flag).AddComment comments
End Sub
Public Sub FlagCollection(all_cells As Collection)
Dim flag_cell As ValidatorError
For Each flag_cell In all_cells
flag flag_cell.field, flag_cell.error_message
Next flag_cell
End Sub
Public Sub Unflag()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearComments
End Sub
Public Function has_comments(c_cell As String) As Boolean
On Error Resume Next
Sheet1.Range(c_cell).comment.Text
has_comments = Not (CLng(Err.Number) = 91)
End Function
This will flag every field that has an error in yellow and add a comment as to what the issue is you could also determine a way to tell the user exactly where the errors are using v.uniq_keys which returns a collection of cell address' that fail validation of presence.
I'm pretty sure I cracked it, well it works anyway. Code below (for those who are interested anyway!!)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rsave As Range
Dim cell As Range
Set rsave = Sheet2.Range("Table1[Estimated Claim (USD)]")
For Each cell In rsave
If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then
Dim missdata
missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
Cancel = True
cell.Offset(0, 1).Select
Exit For
End If
Next cell
End Sub
I've now got to loop this through three other column headers checking for same criteria. If anyone knows a quicker code method. Would appreciate the help!