I am writing a code to color user's input to a written questions. I am fairly new to vba, the code is working fine but I want to improve it, that is detect errors and incase something goes wrong with the code the documents still functions normally.
I have two types of input, either the user select something from dropdown menu or write his/her own answer (usually numbers, so I have a function to trim the answer for numbers incase there was character).
example:
Q:Number of work hours?
A: Five (5) ----> the code check the value (5) and based on it the "Five (5)" color changes to green.
I appreciate your help.
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As
Boolean, Cancel As Boolean)
Dim store As String
Dim storeNum As Integer
If ActiveDocument.Bookmarks.Exists("high") = True Then
store = ActiveDocument.Bookmarks("high").Range.Text
If store = "0" Then
ActiveDocument.Bookmarks("high").Range.Font.TextColor = RGB(103, 106, 110)
Else
ActiveDocument.Bookmarks("high").Range.Font.TextColor = vbRed
End If
End If
If ActiveDocument.Bookmarks.Exists("medium") = True Then
End If
If (ActiveDocument.Bookmarks.Exists("bidders") = True) And (ActiveDocument.Bookmarks("bidders").Range.Text <> "Number of primary bids received and alternatives") Then
storeNum = ExtractNumber(ActiveDocument.Bookmarks("bidders").Range)
If storeNum > 7 Then
ActiveDocument.Bookmarks("bidders").Range.Font.TextColor = RGB(0, 176, 80)
ElseIf (storeNum > 3) And (storeNum < 8) Then
ActiveDocument.Bookmarks("bidders").Range.Font.ColorIndex = wdDarkYellow
ElseIf storeNum < 4 Then
ActiveDocument.Bookmarks("bidders").Range.Font.TextColor = vbRed
End If
End If
For Each oContentControl In ActiveDocument.ContentControls
If oContentControl.Type = wdContentControlRichText Then
oContentControl.Range.Font.Color = RGB(103, 106, 110)
oContentControl.Range.Font.Name = "Trebuchet MS"
oContentControl.Range.Font.Size = 11
oContentControl.Application.ActiveDocument.Paragraphs.Alignment = wdAlignParagraphJustify
End If
Next
ActiveDocument.Fields.Update
End Sub
Function ExtractNumber(rCell As Range)
Dim iCount As Integer, i As Integer
Dim sText As String
Dim lNum As String
sText = rCell
For iCount = Len(sText) To 1 Step -1
If IsNumeric(Mid(sText, iCount, 1)) Then
i = i + 1
lNum = Mid(sText, iCount, 1) & lNum
End If
If i = 1 Then lNum = CInt(Mid(lNum, 1, 1))
Next iCount
ExtractNumber = CLng(lNum)
End Function
Well... it is a broad question but there a few problems nonetheless:
If (ActiveDocument.Bookmarks.Exists("bidders") = True) And ActiveDocument.Bookmarks("bidders").Range.Text <> "Number of primary bids
received and alternatives") Then
Because both parts of the And are evaluated. In other words, even if the bookmark "bidders" does not exist you are still asking for the text, which generates an error.
A better way would be to use a nested If:
If (ActiveDocument.Bookmarks.Exists("bidders") = True) Then
If ActiveDocument.Bookmarks("bidders").Range.Text <> "Number of primary bids received and alternatives") Then
' Your Code
End If
End If
Also this If block is empty (best to delete it):
If ActiveDocument.Bookmarks.Exists("medium") = True Then
End If
You may also run into trouble with the content controls, sometimes they can be locked for editing in which case you may expect an error when you try to set the font .name, .color, .size.
You can test and set whether or not a content control is locked with this:
If activedocument.ContentControls(1).LockContents = True Then ' Prevent edit
If activedocument.ContentControls(1).LockContentControl = True Then ' Prevent delete
' Note you don't actually need the " = True", it is just there for clarity
Related
What I am trying to do is on a Word Userform, if I select a number in a combo box (cb_CountCohorts) (options are 1-10) then any control (option button or textbox that contains that number +1 (so if I select 5, those controls that have 6-10) will not be visible.
With that being said, I did get it to work but I know that it is not efficient.
Below is the beginning but I realize for each case, there would have to be 10 more sets of what you see below times 10 different If statements. Is there a way to say something like if cb_Countcohrts ="1" find all controls in this frame that does not contain Cohort 1 and hide it...if cb_countcohorts ="5" then hide everything that contains cohort 6, 7, 8, 9, 10? Thanks in advance for all and any help
Private Sub cb_CountCohorts_Change()
If cb_CountCohorts = "1" Then
txt_cohort1.Visible = True
txt_cohort2.Visible = False
txt_cohort3.Visible = False
txt_cohort4.Visible = False
txt_cohort5.Visible = False
txt_cohort6.Visible = False
txt_cohort7.Visible = False
txt_cohort8.Visible = False
txt_cohort9.Visible = False
txt_cohort10.Visible = False
I tried this too but it doesnt seem to work like I want either
Private Sub cb_CountCohorts_Change()
For i = 2 To 10
Set VarText = frm_master.Controls("txt_cohort" & i)
If cb_CountCohorts.Value > VarText.Value Then
VarText.Visible = False
End If
Next i
End Sub
Something like this:
Private Sub cb_CountCohorts_Change()
Dim v As Long, i As Long
v = CLng(cb_CountCohorts.Value)
For i = 2 To 10
Me.Controls("txt_cohort" & i).Visible = (i <= v)
'any other controls here....
Next i
End Sub
If you want something generic for all controls (assuming a consistent naming convention) -
Private Sub cb_CountCohorts_Change()
Dim v As Long, c, i As Long, arr
v = CLng(cb_CountCohorts.Value)
For Each c In Me.Controls
If c.Name Like "txt_cohort#*" Then
arr = Split(c.Name, "_")
i = CLng(Replace(arr(1), "txt_cohort", ""))
c.Visible = (i <= v)
End If
Next c
End Sub
...basically expanded from Robert's suggestion
Untested, but this should work:
Dim c As Control
For Each c In Me.Controls
If InStr(TypeName(c),"cohort") Then
c.Visible = False
End If
Next
I'm currently writing code for a game called Caladont.
The game is about first player saying the word and the next one has to say the word that starts with last two letters of previous word.
The problem comes when I want to check if word contains less than 3 letters or if it's empty.
In the first cycle when list for filling is still empty, everything is fine.
However, after I type for example 5 or more words and type a single letter or leave it empty, it prints two "You've lost!" messages, which means that code from if statement is being ignored since it changes bool variable to false and is supposed to exit the While loop.
I've tried replacing ok = false with Exit While in condition which checks if words contains less than 3 letters and it worked, but I want to understand what is the problem.
The code can also be found here [Caladont game
GitHub](https://github.com/whistleblower91/VB.net/blob/master/Caladont%20game):
Module Module1
Sub Main()
Kaladont()
End Sub
Sub Kaladont()
Const msg As String = "You've lost!"
Dim list As New List(Of String)
Dim word As String
Dim i As Integer
Dim ok As Boolean
ok = True
While ok
Console.Write("Insert word:")
word = Console.ReadLine()
list.Add(word)
If word.Length < 3 Or word = "" Then
Console.WriteLine(msg)
ok = False
End If
If list.Count > 1 Then 'Skip checking first word
For i = 0 To list.Count - 2
If word.ToLower = lista(i).ToLower Then
Console.WriteLine(msg)
ok = False
End If
Next
If LastTwo(word) = "ka" Or LastTwo(word)="nt" Then
Console.WriteLine("KALADONT! You won!")
ok = False
End If
If FirstTwo(list.Last) <> LastTwo(list(list.Count - 2)) Then
Console.WriteLine(msg)
ok = False
End If
End If
End While
Check()
End Sub
Function FirstTwo(ByVal s1 As String) As String
Return Left(s1.ToLower, 2)
End Function
Function LastTwo(ByVal s2 As String) As String
Return Right(s2.ToLower, 2)
End Function
Sub Check()
Dim sign As Char
Console.WriteLine("Do you want to start new game? y\n")
sign = Console.ReadLine()
If sign = CChar("y") Then
Console.Clear()
Kaladont()
ElseIf sign = CChar("n") Then
Exit Sub
End If
End Sub
End Module
Any solutions?
Even if you set ok to false, it will still go inside the other loop, you'll need to use Else
If word.Length < 3 Or word = "" Then
Console.WriteLine(msg)
ok = False
Else If list.Count > 1 Then 'Skip checking first word
An other way would be to exit the while with End while.
If word.Length < 3 Or word = "" Then
Console.WriteLine(msg)
ok = False
Exit While
End If
Hello,
I am trying to set up a form which is a calendar from which the user can select a date (by default the current month appears). The form consists of 42 command buttons (I have left the default name ie. CommandButton1) which I am setting the day number.
At the moment I have a long-winded section of code for each button (I used Excel to generate this rather than type it all out) which locks and hides the button if it is outside of the month in question which looks like this:
NewDate.CommandButton1.Caption = Format(DATlngFirstMonth - DATintDayNumFirst + DATintX, "dd")
If DATintX < DATintDayNumFirst Then
With NewDate.CommandButton1
.Locked = True
.Visible = DATbooShowExtraDays
.ForeColor = RGB(150, 150, 150)
End With
Else
With NewDate.CommandButton1
.Locked = False
.Visible = True
.ForeColor = RGB(0, 0, 0)
End With
End If
I know that I can refer to a command button by:
Dim objCommandButton As Object
Set objCommandButton = NewDate.CommandButton1
..which neatens the code up somewhat. But what I would like to do is refer to the command button as a string so I can loop through all 42, ie.
Dim n as integer
n = 1
Do Until n > 42
Set objCommandButton = NewDate.CommandButton & n
'Some operations
n = n + 1
Loop
Many thanks in advance for assistance.
You can loop through all controls of the form. Try
Sub LoopButtons()
Dim it As Object
For Each it In NewDate.Controls
Debug.Print it.Name
Next it
End Sub
Then you can put conditional expression (if ... then) in place of Debug.Print or whatever. For example
If Instr(it.Name, "CommandButton") Then
'do your code
end if
Here's code which iterates over ActiveX controls on active sheet:
Sub IterateOverActiveXControlsByName()
Dim x As Integer
Dim oleObjs As OLEObjects
Dim ctrl As MSForms.CommandButton
Set oleObjs = ActiveSheet.OLEObjects
For x = 1 To 10
Set ctrl = oleObjs("CommandButton" & x).Object
Next
End Sub
I have written a VBA function to calculate the weight of a determine the weight of a certain item from its model number by comparing it to the model number of items with known weights. For some reason it is only returning #NAME?
Here is the code:
Function getWeight(model As String) As Double
Dim weight As Double
weight = -1#
Dim compModel As String
compModel = ""
Dim prevNumMatches As Integer
prevNumMatches = 0
Dim numMatches As Integer
numMatches = 0
Dim i As Integer
Dim p As Integer
Dim samePump As Boolean
Dim sameMotor As Boolean
Dim special As Boolean
For i = 2 To 1000
compModel = CStr(Sheets("Weights").Cells(i, 1).Value)
For p = 1 To Len(compModel)
samePump = False
sameMotor = False
special = False
numMatches = 0
If p = 1 Then
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
samePump = True
numMatches = numMatches + 1
End If
ElseIf p = 5 Then
If Mid(model, p, 1) <> "-" Then
special = True
End If
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
numMatches = numMatches + 1
End If
ElseIf p = 9 Then
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
sameMotor = True
numMatches = numMatches + 1
End If
Else
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
numMatches = numMatches + 1
End If
End If
If samePump And (sameMotor Or special) Then
If numMatches > prevNumMatches Then
weight = CDbl(Sheets("Weights").Cells(i, 2).Value)
prevNumMatches = numMatches
ElseIf numMatches = prevNumMatches Then
If CDbl(Sheets("Weights").Cells(i, 2).Value) > weight Then
weight = CDbl(Sheets("Weights").Cells(i, 2).Value)
End If
End If
End If
Next p
Next i
If weight = -1# Then
getWeight = 0#
Else
getWeight = weight
End If
End Function
Why is this not returning a number as I expect?
Each iteration of the
p = 1 to len(compmodel)
loop resets all your Booleans to false. This means the statement
If samePump And (sameMotor Or special) Then
is never true because it never evaluates all of those on the same pass of the loop. Put the boolean setters before the start of the loop instead of in it.
samePump = False
sameMotor = False
special = False
numMatches = 0
For p = 1 To Len(compModel)
Also if you did want to use the debugger just run this. That way you can step through the code line by line and see whats going on.
Sub main()
Dim THingy As Double
THingy = getWeight("R221-FT-AA1")
MsgBox (THingy)
End Sub
The function is (implicitly) Public, so the only way to get a #NAME? error is to implement it in the wrong type of module, such that Excel doesn't know what =getWeight is referring to.
You need to add a standard procedural module (.bas) to your project, cut the function, and paste it in there.
Bugs aside, you should be able to call your UDF from the worksheet.
ThisWorkbook, as well as all Worksheet modules, UserForm modules, and plain class modules, are blueprints for objects, which means in order to call their public members you need to qualify the member calls with an instance of that class... and a UDF (or macro for that matter) call can't do that.
I found the problem. Even though the file was saved as a macro enabled workbook (.xlsm) macros were not enabled. When I reopened it this morning, it gave me the option to enable macros. Once I did that and corrected the code as Jared suggested, it all worked as planned.
I am a VB.NET beginner.
I want to achieve following:
Node1 is clicked which opens a panel containing check-boxes.
The user will click a few check-boxes.
The user clicks node2 which will export check-box information to an Excel sheet column, and reset the panel.
New information entered on panel is exported to an adjacent column in the same Excel sheet used in step3.
The above process continues for 90 nodes.
How do I do the first part in steps 3, 4 and 5?
This is my first try which is not working:
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
oWB = oXL.Workbooks.Open("F:\open.xlsx")
oSheet = oWB.Worksheets("Sheet1")
'I am not able to think clearly on following loop
For i = 1 To 3
For j = 1 To 90
If CheckBox1.Checked Then
oSheet.Cells(i, j).value = "1"
Else : oSheet.Cells(i, j).value = "0"
End If
If CheckBox2.Checked Then
oSheet.Cells(i, j).value = "1"
Else : oSheet.Cells(i, j).value = "0"
End If
If CheckBox3.Checked Then
oSheet.Cells(i, j).value = "1"
Else : oSheet.Cells(i, j).value = "0"
End If
Next
Next
'Following works
CheckBox1.Checked() = False
CheckBox2.Checked() = False
CheckBox3.Checked() = False
ComboBox1.ResetText()
What you clearly need is a way to store the user's selections in memory, before saving them to the spreadsheet. There are several ways you could do this, but given your inexperience I suggest you consider the simplest, which is to define a basic class to represent the user's selections for a single node, and an array – where each item is an instance of the class – to store the entire set of user selections.
Define the node selection class – to represent selections for a single node:
Public Class NodeSelection
Public CheckA As Boolean
Public PickAIndex As Integer = -1
Public CheckB As Boolean
Public PickBIndex As Integer = -1
Public CheckC As Boolean
Public PickCIndex As Integer = -1
Public ItemProcessed As Boolean
End Class
Define your variables – in your form class (not in a sub):
Private _userPicks(89) As NodeSelection 'Array of user's selections
Private _previousIndex As Integer = -1 'Used to record the previously selected node
Instantiate the array items – in the form's Load event:
'Instantiate the class for each element of the array
For i As Integer = 0 To _userPicks.Count - 1
_userPicks(i) = New NodeSelection
Next
Keeping track of user selections:
Whenever a new node is selected, you need to update the array item for the previously selected node then reset the controls for the current node. This is best done in the treeview's AfterSelect event:
Private Sub TreeView1_AfterSelect(sender As Object, e As System.Windows.Forms.TreeViewEventArgs) Handles TreeView1.AfterSelect
'Exit if the click is on the parent node (Node0)
If e.Node.GetNodeCount(False) > 0 Then Return
UpdateNodeInfo()
'If the currently selected node has already been processed,
'restore user selection values to the controls,
'otherwise reset the controls
With _userPicks(e.Node.Index)
CheckBox1.Checked = If(.ItemProcessed, .CheckA, False)
ComboBox1.SelectedIndex = If(.ItemProcessed, .PickAIndex, -1)
CheckBox2.Checked = If(.ItemProcessed, .checkB, False)
ComboBox2.SelectedIndex = If(.ItemProcessed, .PickBIndex, -1)
CheckBox3.Checked = If(.ItemProcessed, .checkC, False)
ComboBox3.SelectedIndex = If(.ItemProcessed, .PickCIndex, -1)
End With
'Color the previous selection so the user can see it's been processed
If _previousIndex >= 0 Then TreeView1.Nodes(0).Nodes(_previousIndex).BackColor = Color.AntiqueWhite
'Record this (selected) node's index for updating when the next node is selected
_previousIndex = e.Node.Index
End Sub
Private Sub UpdateNodeInfo()
If _previousIndex < 0 Then Return 'No item has been set yet
With _userPicks(_previousIndex)
.CheckA = CheckBox1.Checked
.PickAIndex = If(.CheckA, ComboBox1.SelectedIndex, -1)
.CheckB = CheckBox2.Checked
.PickBIndex = If(.CheckB, ComboBox2.SelectedIndex, -1)
.checkC = CheckBox3.Checked
.PickCIndex = If(.checkC, ComboBox3.SelectedIndex, -1)
.ItemProcessed = True 'Record the fact the item has already been processed
End With
End Sub
Writing values to the spreadsheet:
Notice that I put the array item update routine in a separate procedure. This is because you will have to update the final selection before writing it all out to the spreadsheet. I presume you will have a button to save their selections, so you just need to call the UpdateNodeInfo sub from there before iterating over the array and writing the values. Here is how you might iterate over the values and update the spreadsheet:
For i As Integer = 0 To _userPicks.Count - 1
With _userPicks(i)
oSheet.Cells(3, i + 2) = "Node" & (i + 1).ToString
oSheet.Cells(9, i + 2) = "Node" & (i + 1).ToString
oSheet.Cells(4, i + 2) = If(.ItemProcessed AndAlso .CheckA, 1, 0)
oSheet.Cells(5, i + 2) = If(.ItemProcessed AndAlso .CheckB, 1, 0)
oSheet.Cells(6, i + 2) = If(.ItemProcessed AndAlso .checkC, 1, 0)
oSheet.Cells(10, i + 2) = If(.ItemProcessed AndAlso .CheckA, ComboBox1.Items(.PickAIndex).ToString, "")
oSheet.Cells(11, i + 2) = If(.ItemProcessed AndAlso .CheckB, ComboBox1.Items(.PickBIndex).ToString, "")
oSheet.Cells(12, i + 2) = If(.ItemProcessed AndAlso .checkC, ComboBox1.Items(.PickCIndex).ToString, "")
End With
Next
I assume you already know how to open, save and close the spreadsheet, so I'll leave that side of it up to you. Get familiar with the methods outlined here and post another question if you don't.
Finally
The above is a fairly simple way to achieve what you're trying to do. If you think you may need to add more functionality to your class, you should look at substituting public members for properties – some would say you should do that anyway – and you may want to consider storing the complete set of user selections in a List(Of T) object rather than an array.