I have a Data Sheet form which has a calculated field column. However the field will not display even though it has the correct value. The field in question is "numRisk":
Sub Calculate_Risk (Form As Object)
Dim OrderPrice, IfDonePrice, TotBrSymComm, BrComm, Risk As Double
Dim Symbol As String
Dim IntRateMult, noContracts As Integer
If MinTick = 0 OR Rate = 0 Then
Exit Sub
End If
Symbol = RTrim(Form.getByName("txtSymbol").CurrentValue)
If Symbol = "" Then
Exit Sub
End If
OrderPrice = Form.getByName("fmtOrder_Price").CurrentValue
IfDonePrice = Form.getByName("fmtIf_Done_Price").CurrentValue
noContracts = Form.getByName("fmtNo_Contracts").CurrentValue
If NOT USIntRates Then
Risk = ABS(OrderPrice - IfDonePrice) / MinTick
Else
Risk = ABS(OrderPrice\1 - IfDonePrice\1) * MinTick
IntRateMult = IIf(Symbol = "FV" OR Symbol = "TU",400, 200)
Risk = ABS(Risk - IntRateMult * ABS(OrderPrice - OrderPrice\1
IfDonePrice + IfDonePrice\1))
End If
Risk = Risk * MinTickVal / Rate
TotBrSymComm = BrSymComm + BrSymCommAud
BrComm = IIf(TotBrSymComm = 0, BrCommission, BrSymCommAud + BrSymComm/Rate)
Risk = noContracts*(Risk + BrComm * 2)
Form.getByName("numRisk").Value = Risk
End Sub
The subroutine is called from the following routine which is triggered when the form is loaded:
Sub FromListForm(Event as Object)
Dim Form As Object
Dim TodaysDate As New com.sun.star.util.Date
Dim CurrDate As Date
Form=Event.Source.getByName("MainForm_Grid")
Form.RowSet.first()
Do Until Form.RowSet.isAfterLast()
Get_Contract(Form)
Get_Broker_Comm(Form)
Calculate_Risk(Form)
If isEmpty(Form.getByName("OrderDate").Date) Then
CurrDate = Date()
TodaysDate.Day = Day(CurrDate)
TodaysDate.Month = Month(CurrDate)
TodaysDate.Year = Year(CurrDate)
Form.getByName("OrderDate").CurrentValue = TodaysDate
End If
Form.RowSet.next()
Loop
Form.RowSet.last()
End Sub
Also is there a more efficient method to cycle through the rows? As this seems so slow I can see the row pointer moving down the table as each row is processed.
If I understand correctly, you're trying to enter individual values into each cell in a column of a tablegrid control? I don't believe that's possible.
Inside a tablegrid control, all values have to come from the underlying query. I recommend writing a query to do these calculations, and using that query as the basis for the form - that would solve both the problem of displaying the calculated result as well as improving the load speed of the form (since database logic in determining query results is almost always more efficient than a macro going row-by-row).
Alternately, you could have the calculated field be standalone, showing only the calculated result for the currently selected row of the tablegrid control. In this scenario, the "form loaded" event would only do the calculation for the first row, and the calculating macro would be triggered each time the row selection changed.
Related
This is my code
Public Sub InvoicItmCall()
'If IteDataTb.Rows.Count = 0 Then Exit Sub
SellingDGView.Rows.Add()
SellingDGView.Rows.Item(0).Cells(0).Value = SellingDGView.Rows.Item(0).Cells(0).Value + 1
SellingDGView.Rows.Item(0).Cells(1).Value = IteDataTb.Rows(0).Item("IteFName")
SellingDGView.Rows.Item(0).Cells(2).Value = IteDataTb.Rows(0).Item("IteFSizeUnit")
SellingDGView.Rows.Item(0).Cells(4).Value = IteDataTb.Rows(0).Item("IteFSellpris")
SellingDGView.Rows.Item(0).Cells(6).Value = IteDataTb.Rows(0).Item("IteVat")
'Dim unused = SellingDGView.Rows.Add(rows)
End Sub
Right now, the code works fine and fills the first row on the grid, this is for a barcode scanner. When I scan one barcode, it fills the row with the appropriate data. However, when I scan another code, it overwrites the older row.
I want it to add a new row and add the other data to it.
So when I scan a different item after the first one, it should fill up a new row.
How do I do that?
Thanks in advance :)
EDIT:
I have found a workaround
If IteDataTb.Rows.Count > 0 Then
For Each row As DataRow In IteDataTb.Rows
SellingDGView.Rows.Add(row.Item("IteFName"), row.Item("IteFSizeUnit"), row.Item("IteFSellpris"), row.Item("IteVat"))
Next row
End If
This creates a new row every time and fills it. But now I want to fill specific cells.
How do I do that?
Right now it fills everything inappropriately.
If you wanted to do it the way you originally were, I'd do it like this:
Dim index = SellingDGView.Rows.Add()
Dim newRow = SellingDGView.Rows(index)
'Dim newRow = SellingDGView.Rows(SellingDGView.Rows.Add())
Dim dataRow = IteDataTb.Rows(0)
newRow.Cells(0).Value = SellingDGView.Rows(0).Cells(0).Value + 1
newRow.Cells(1).Value = dataRow("IteFName")
newRow.Cells(2).Value = dataRow("IteFSizeUnit")
newRow.Cells(4).Value = dataRow("IteFSellpris")
newRow.Cells(6).Value = dataRow("IteVat")
If you wanted to use the more appropriate overload of Add that I mentioned and you used in your second example:
For Each row As DataRow In IteDataTb.Rows
SellingDGView.Rows.Add(SellingDGView.Rows(0).Cells(0).Value + 1,
row("IteFName"),
row("IteFSizeUnit"),
Nothing,
row("IteFSellpris"),
Nothing,
row("IteVat"))
Next
The If statement is pointless.
Also, I doubt that you're getting the next ID in the best way with that expression that adds 1 but that's a different question.
Every time that you need a new row, you can do as follows:
Dim i As Integer = SellingDGView.Rows.Add()
SellingDGView.Rows.Item(i).Cells(0).Value = i
SellingDGView.Rows.Item(i).Cells(1).Value = IteDataTb.Rows(j).Item("IteFName")
SellingDGView.Rows.Item(i).Cells(2).Value = IteDataTb.Rows(j).Item("IteFSizeUnit")
SellingDGView.Rows.Item(i).Cells(4).Value = IteDataTb.Rows(j).Item("IteFSellpris")
SellingDGView.Rows.Item(i).Cells(6).Value = IteDataTb.Rows(j).Item("IteVat")
Herein, I've assumed that the variable "j" indicates to your desired row in IteDataTb datagridview. I mean that you should control the "j" variable yourself. I can help you if know more about the IteDataTb.
I tried reading other posted questions about this error but I am still having trouble understanding it.
I was having errors after renaming variables and posted this question, I use option explicit and debug my code and it fixed my naming problems, But I still am having one problem in that 2 out of my 21 comboboxes in the operations row are still getting this same error. How can they get an error when they are using the same functions as the other 19. I checked their names and they are correct how could this be??
I have a form that I have build that is set up to look and function similar to and excel spreadsheet. This is the layout, Column Names first and then Control type
Operation Time/Min DecTime LaborRate Cost MarkUp Total
ComboBox TextBox Label Label Label TextBox Label
So all together I have 7 columns with 21 rows (not including column names) in which I can input data. Any where there is a label there is no user input its value is simply derived from the other fields.
I used the following naming convention for my form controls cb_op1, cb_op2, cb_op3 ... I just increment it by one to mimic the row number (control name plus row number). Operation = cb_op, Time = tb_time, DecTime = tb_Dectime, LaborRate = tb_LbrRate, Cost = tb_Cost, MarkUp = tb_MU, Total = tb_Total.
I wrote functions for the AfterUpdate events for my controls. This first function gets the value of the control based on its row number and then allows me to assign it to a variable this fuction is used for multiple controls update events.
Private Function GetControlValue(name As String) As Object
Dim obj As Object
For Each obj In Me.Controls
If obj.name = name Then
Set GetControlValue = obj
Exit Function
End If
Next
End Function
The next function is used to actually update the other field in the row based on the after update event. I use the GetControlValue Function listed above in this function. This is just for the operations column.
Private Function OperationsUpdate(RowNumber As Integer)
Dim Operations As Object
Dim Time As Object
Dim DecTime As Object
Dim LaborRate As Object
Set Operations = GetControlValue("cb_op" & RowNumber)
Set Time = GetControlValue("tb_time" & RowNumber)
Set DecTime = GetControlValue("tb_DecTime" & RowNumber)
Set LaborRate = GetControlValue("tb_LbrRate" & RowNumber)
Set Cost = GetControlValue("tb_Cost" & RowNumber)
If IsNull(Time.Value) Then
If IsNull(Operation.Value) Then
Cost.Value = ""
LaborRate.Value = ""
Else
LaborRate.Value = DLookup("LaborRate", "OperationsType", "[operationsID] = " & Operation.Value)
End If
Else
If IsNull(Operation.Value) Then
Cost.Value = ""
LaborRate.Value = ""
Else
LaborRate.Value = DLookup("LaborRate", "OperationsType", "[operationsID] = " & Operation.Value)
Cost.Value = DecTime.Value * LaborRate.Value
End If
End If
FormObjectsUpdate2 (RowNumber)
Set Operations = Nothing
Set Time = Nothing
Set DecTime = Nothing
Set LaborRate = Nothing
Set Cost = Nothing
End Function
Finally this is how my After update events look per control. I post just the first three not all 21 to save space.
Private Sub cb_op1_AfterUpdate()
OperationsUpdate (1)
End Sub
Private Sub cb_op2_AfterUpdate()
OperationsUpdate (2)
End Sub
Private Sub cb_op3_AfterUpdate()
OperationsUpdate (3)
End Sub
I just posted the function and the code for the first column operations all the other after update events are now having the same issues too.
I have a Part class with the fields list in the code below. I have a DataGridView control, which I am filtering with the Advanced DGV (ADGV) DLL from NUGET. I must include the ADGV in my winform. I currently have a DataGridView, a search box on the form, and a button to run the following function. I need to go through all of the visible rows, collect a unique list of part numbers with their most recent revisions, and then color the rows in DataGridView which are out of date by checking the part number and rev on each row against the mostuptodate list. For 45,000 entries displayed in DataGridView, this take ~17 secs. For ~50 entries, it take ~1.2 seconds. This is extremely inefficient, but I can't see a way to cut the time down.
Sub highlightOutdatedParts()
'Purpose: use the results in the datagridview control, find the most recent revision of each part, and
' highlight all outdated parts relative to their respective most recent revisions
'SORT BY PART NUMBER AND THEN BY REV
If resultsGrid.ColumnCount = 0 Or resultsGrid.RowCount = 0 Then Exit Sub
Dim stopwatch As New Stopwatch
stopwatch.Start()
resultsGrid.Sort(resultsGrid.Columns("PartNumber"), ListSortDirection.Ascending)
Dim iBag As New ConcurrentBag(Of Part)
Dim sortedList As Generic.List(Of Part)
For Each row As DataGridViewRow In resultsGrid.Rows
If row.Visible = True Then
Dim iPart As New Part()
Try
iPart.Row = row.Cells(0).Value
iPart.Workbook = CStr(row.Cells(1).Value)
iPart.Worksheet = CStr(row.Cells(2).Value)
iPart.Product = CStr(row.Cells(3).Value)
iPart.PartNumber = CStr(row.Cells(4).Value)
iPart.ItemNo = CStr(row.Cells(5).Value)
iPart.Rev = CStr(row.Cells(6).Value)
iPart.Description = CStr(row.Cells(7).Value)
iPart.Units = CStr(row.Cells(8).Value)
iPart.Type = CStr(row.Cells(9).Value)
iPart.PurchCtgy = CStr(row.Cells(10).Value)
iPart.Qty = CDbl(row.Cells(11).Value)
iPart.TtlPerProd = CDbl(row.Cells(12).Value)
iPart.Hierarchy = CStr(row.Cells(13).Value)
iBag.Add(iPart)
Catch ice As InvalidCastException
Catch nre As NullReferenceException
End Try
End If
Next
sortedList = (From c In iBag Order By c.PartNumber, c.Rev).ToList() ' sort and convert to list
Dim mostUTDRevList As New Generic.List(Of Part) ' list of most up to date parts, by Rev letter
For sl As Integer = sortedList.Count - 1 To 0 Step -1 'start at end of list and work to beginning
Dim query = From entry In mostUTDRevList ' check if part number already exists in most up to date list
Where entry.PartNumber = sortedList(sl).PartNumber
Select entry
If query.Count = 0 Then ' if this part does not already exist in the list, add.
mostUTDRevList.Add(sortedList(sl))
End If
Next
'HIGHLIGHT DATAGRIDVIEW ROWS WHERE PART NUMBERS ARE OUT OF DATE
For Each row As DataGridViewRow In resultsGrid.Rows
' if that part with that Rev does not exist in the list, it must be out of date
Try
Dim rowPN As String = CStr(row.Cells(4).Value).ToUpper ' get part number
Dim rowR As String = CStr(row.Cells(6).Value).ToUpper ' get Rev
Dim query = From entry In mostUTDRevList ' check if that part number with that Rev is in the list.
Where entry.PartNumber.ToUpper.Equals(rowPN) AndAlso
entry.Rev.ToUpper.Equals(rowR)
Select entry
If query.Count = 0 Then ' if the part is out of date highlight its' row
row.DefaultCellStyle.BackColor = Color.Chocolate
End If
Catch ex As NullReferenceException
Catch ice As InvalidCastException
End Try
Next
resultsGrid.Select()
stopwatch.Stop()
If Not BackgroundWorker1.IsBusy() Then timertextbox.Text = stopwatch.Elapsed.TotalSeconds.ToString & " secs"
MessageBox.Show("Highlighting completed successfully.")
End Sub
It is almost always faster to work with the data than the control. The control is simply the means to present a view of the data (in a grid) to the users. Working with the data from there requires too much converting to be effieicent. Then, use the DGV events to highlight the rows
Its hard to tell all the details of what you are doing, but it looks like you are comparing the data to itself (as opposed to some concrete table where the lastest revision codes are defined). Nor is it clear why the datasources are collections, ConcurrentBags etc. The key would be to use collections optimized for the job.
To demonstrate, I have a table with 75,000 rows; the product codes are randomly selected from a pool of 25,000 and a revision code is a random integer (1-9). After the DGV datasource is built (a DataTable) a LookUp is created from the ProductCode-Revision pair. This is done once and once only:
' form level declaration
Private PRCodes As ILookup(Of String, Int32)
' go thru table
' group by the product code
' create an anon Name-Value object for each,
' storing the code and highest rev number
' convert result to a LookUp
PRCodes = dtSample.AsEnumerable.
GroupBy(Function(g) g.Item("ProductCode"),
Function(key, values) New With {.Name = key.ToString(), .Value = values.
Max(Of Int32)(Function(j) j.Field(Of Int32)("RevCode"))
}).
ToLookup(Of String, Int32)(Function(k) k.Name, Function(v) v.Value)
Elapsed time via stopwatch: 81 milliseconds to create the collection of 23731 items. The code uses an anonymous type to store a Max Revision code for each product code. A concrete class could also be used. If you're worried about mixed casing, use .ToLowerInvariant() when creating the LookUp (not ToUpper -- see What's Wrong With Turkey?) and again later when looking up the max rev.
Then rather than looping thru the DGV rows use the RowPrePaint event:
If e.RowIndex = -1 Then Return
If dgv1.Rows(e.RowIndex).IsNewRow Then Return
' .ToLowerInvariant() if the casing can vary row to row
Dim pc = dgv1.Rows(e.RowIndex).Cells("ProductCode").Value.ToString()
Dim rv = Convert.ToInt32(dgv1.Rows(e.RowIndex).Cells("RevCode").Value)
Dim item = PRCodes(pc)(0)
If item > rv Then
dgv1.Rows(e.RowIndex).DefaultCellStyle.BackColor = Color.MistyRose
End If
Notes
It takes some time to create the DataSource, but 75,000 rows is a lot to throw at a user
The time to create the LookUp is minimal - barely measurable
There is no noticeable wait in displaying them because a) the LookUp is made for this sort of thing, b) rows are done as needed when they are displayed. Row # 19,999 may never be processed if the user never scrolls that far.
This is all geared to just color a row. If you needed to save the Current/NotCurrent state for each row, add a Boolean column to the DataTable and loop on that. The column can be invisible if to hide it from the user.
The random data results in 47,000 out of date RevCodes. Processing 75k rows in the DataTable to set the flag takes 591 milliseconds. You would want to do this before you set the DataTable as the DataSource to prevent changes to the data resulting in various events in the control.
In general, the time to harvest the max RevCode flag and even tag the out of date rows is a trivial increment to creating the datasource.
The Result:
The data view is sorted by ProductCode so that the coloring of lower RevCodes is apparent.
We surely cant grok all the details and constraints of the system from a small snippet - even the data types and original datasource are a guess for us. However, this should provide some help with better look-up methods, and the concept of working with the data rather than the user's view.
One thing is the revision code - yours is treating them as a string. If this is alphanumeric, it may well not compare correctly - "9" sorts/compares higher than "834" or "1JW".
See also:
Lookup(Of TKey, TElement) Class
Anonymous Types
The solution was spurred in part by #Plutonix.
Sub highlightOutdatedParts()
If resultsGrid.ColumnCount = 0 Or resultsGrid.RowCount = 0 Then Exit Sub
Dim stopwatch As New Stopwatch
stopwatch.Start()
resultsGrid.DataSource.DefaultView.Sort = "PartNumber ASC, Rev DESC"
resultsGrid.Update()
'HIGHLIGHT DATAGRIDVIEW ROWS WHERE PART NUMBERS ARE OUT OF DATE
Dim irow As Long = 0
Do While irow <= resultsGrid.RowCount - 2
' if that part with that Rev does not exist in the list, it must be out of date
Dim utdPN As String = resultsGrid.Rows(irow).Cells(4).Value.ToString().ToUpper()
Dim utdRev As String = resultsGrid.Rows(irow).Cells(6).Value.ToString().ToUpper()
Dim iirow As Long = irow + 1
'If iirow > resultsGrid.RowCount - 1 Then Exit Do
Dim activePN As String = Nothing
Dim activeRev As String = Nothing
Try
activePN = resultsGrid.Rows(iirow).Cells(4).Value.ToString().ToUpper()
activeRev = resultsGrid.Rows(iirow).Cells(6).Value.ToString().ToUpper()
Catch ex As NullReferenceException
End Try
Do While activePN = utdPN
If iirow > resultsGrid.RowCount - 1 Then Exit Do
If activeRev <> utdRev Then
resultsGrid.Rows(iirow).DefaultCellStyle.BackColor = Color.Chocolate
End If
iirow += 1
Try
activePN = resultsGrid.Rows(iirow).Cells(4).Value.ToString().ToUpper()
activeRev = resultsGrid.Rows(iirow).Cells(6).Value.ToString().ToUpper()
Catch nre As NullReferenceException
Catch aoore As ArgumentOutOfRangeException
End Try
Loop
irow = iirow
Loop
resultsGrid.Select()
stopwatch.Stop()
If Not BackgroundWorker1.IsBusy() Then
timertextbox.Text = stopwatch.Elapsed.TotalSeconds.ToString & " secs"
resultcounttextbox.Text = resultsGrid.RowCount - 1 & " results"
End If
MessageBox.Show("Highlighting completed successfully.")
End Sub
First of all: 30% doesn't matter. That's a question of design. We can also say the first 3 Displayed Columns.
In my DataGridView I am using BackgroundColors for Rows to pass the User some information.
To keep this information visible to the user while Rows are being selected the first 30% of the columns should get the same SelectionBack/ForeColor as the Back/ForeColor.
So far that has never been a problem using
.cells(0).Style.SelectionBackColor = .cells(0).Style.Backcolor
(and so on).
Now I added the function that allows the user to reorder the Columns which makes the following Statement become true:
ColumnIndex != DisplayedIndex.
That statement beeing true makes the SelectionBackColor-Changed cells be somewhere mixed in the row and not in the first columns anymore. It still does the job, but looks terrible.
Is there something like a "DisplayedColumns" collection in order of the .DisplayedIndex Value that i could use to call the first few DisplayedColumns? If not, how could I effectivly create one my own?
Edit:
The user can also hide specific columns, that do not matter for him. So we have to be aware of Column.DisplayedIndex and Column.Visble
Got it working with the following code:
Try
' calculate what is thirty percent
Dim colcount As Integer = oDic_TabToGridview(TabPage).DisplayedColumnCount(False)
Dim thirtyPercent As Integer = ((colcount / 100) * 30)
' Recolor the first 30 % of the Columns
Dim i As Integer = 0
Dim lastCol As DataGridViewColumn = oDic_TabToGridview(TabPage).Columns.GetFirstColumn(DataGridViewElementStates.Visible)
While i < thirtyPercent
.Cells(lastCol.Index).Style.SelectionBackColor = oCol(row.Item("Color_ID") - 1)
.Cells(lastCol.Index).Style.SelectionForeColor = Color.Black
lastCol = oDic_TabToGridview(TabPage).Columns.GetNextColumn(lastCol, DataGridViewElementStates.Visible, DataGridViewElementStates.None)
i += 1
End While
Catch ex As Exception
MsgBox(ex.Message & vbNewLine & ex.StackTrace)
End Try
Let us first assume you are coloring your rows somehow resembling the following manner:
Me.dataGridView1.Rows(0).DefaultCellStyle.BackColor = Color.PowderBlue
Me.dataGridView1.Rows(1).DefaultCellStyle.BackColor = Color.Pink
' ...etc.
In the DataGridView.CellPainting event handler, you can determine if the painting cell falls within the first N columns by utilizing the DataGridViewColumnCollection.GetFirstColumn and DataGridViewColumnCollection.GetNextColumn methods.
If the cell belongs to one these columns, set the cell's SelectionBackColor to the cell's BackColor. Otherwise set it to the default highlighting color.
Dim column As DataGridViewColumn = Me.dataGridView1.Columns.GetFirstColumn(DataGridViewElementStates.Visible)
e.CellStyle.SelectionBackColor = Color.FromName("Highlight")
' Example: Loop for the first N displayed columns, where here N = 2.
While column.DisplayIndex < 2
If column.Index = e.ColumnIndex Then
e.CellStyle.SelectionBackColor = e.CellStyle.BackColor
Exit While
End If
column = Me.dataGridView1.Columns.GetNextColumn(column, DataGridViewElementStates.Visible, DataGridViewElementStates.None)
End While
As a side note: You may want to consider changing the ForeColor on these cells for readability - depending on your row's BackColor choices. Likewise, if only a single cell is selected from one these first N columns, it can be difficult to notice.
I have a Word document with a table that contains the price of an item, the order amount and the item sum, where amount and item sum are Legacy Form Fields:
There are other items available as options that you can chose via checkbox (also Legacy Form Fields):
Code
Now I've created a function that calculates the item sum
Sub order_amount_Click()
Dim amount As Integer
Dim valueFromCell As String
Dim list
Dim value As Double
amount = ActiveDocument.FormFields("order_amount").Result
If amount > 0 Then
valueFromCell = ThisDocument.Tables(1).Cell(5, 3).Range.Text
list = Split(valueFromCell, " ")
value = list(0)
subsum = value * amount
ActiveDocument.FormFields("order_amount_sum").Result = subsum
Else
ActiveDocument.FormFields("order_amount_sum").Result = 0
End If
CalculateSum
End Sub
and another function that calculates the item sum for additional items (if the checkbox is activated) multiplied by the order amount:
Sub optional_item_Click()
Dim checkbox As Integer
Dim valueFromCell As String
Dim list
Dim value As Double
Dim amount As Integer
Dim subsum As Double
checkbox = ActiveDocument.FormFields("optional_item1").Result
amount = ActiveDocument.FormFields("order_amount").Result
If checkbox = 1 And amount > 0 Then
valueFromCell = ThisDocument.Tables(1).Cell(7, 3).Range.Text
list = Split(valueFromCell, " ")
value = list(0)
subsum = value * amount
ActiveDocument.FormFields("optional_item1_sum").Result = subsum
Else
ActiveDocument.FormFields("optional_item1_sum").Result = 0
End If
CalculateSum
End Sub
(There are as many Click() functions as there are optional_item fields, 17 in sum - I haven't generalized the function yet.)
The last line within both Subs is a function call, that calculates the net sum, the VAT and the final total sum
Function CalculateSum()
Dim net As Double
Dim vat As Double
Dim total_sum As Double
net = CDbl(ActiveDocument.FormFields("order_amount_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item1_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item2_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item3_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item4_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item5_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item6_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item7_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item8_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item9_sum").Result)
' Cannot compile when line too long, so splitting into two statements
net = net + CDbl(ActiveDocument.FormFields("optional_item10_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item11_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item12_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item13_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item14_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item15_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item16_sum").Result) + CDbl(ActiveDocument.FormFields("optional_item17_sum").Result)
'MsgBox "net " & net
ActiveDocument.FormFields("net_sum").Result = net
vat = net * 0.19
'MsgBox "vat " & vat
ActiveDocument.FormFields("vat_sum").Result = vat
total_sum = net + vat
'MsgBox "total " & total_sum
ActiveDocument.FormFields("total_sum").Result = total_sum
End Function
Problem
The code itself works fine, all elements are calculated correctly. But there are two major problems that make the whole document almost unusable (all actions for users are restricted to enter their name on top of the document, chose the amount and de-/activate the checkboxes; sum fields aren't accessible):
When I perform an action (e.g. enter an amount) the CalculateSum() function visibly loops over all sum fields (spanned over three pages) and weirdly scrolls on the document along the sum fields.
When I click on a checkbox on the 2nd or 3rd page, the document scrolls up to the first page to the place where I can enter the amount of pieces I want to order.
Now how can I supress all that looping over the sum fields and weirdly scrolling around? And how can I prevent the document from scrolling up to the 1st page?
Any help appreciated! (I'm also thankful for side comments on my code, as I'm new to VBA.)
Update #1
I've added a screencast showing the error.
Update #2
The basic problem seems to be that the macro is scrolling to the position I am referring to in my script, e.g. if I'm using
ActiveDocument.FormFields("total_sum").Result = total_sum
it's scrolling to the total_sum field.
Too difficult for a comment...
For (b) you have to use VBA - you can't use the trick I suggested elsewhere with the FormFields checkboxes, only with the Content Control ones.
For (c), something like this (not tested)
Make sure the On Exit macro is set for optional_item1 and the Calculate on Exit is also set. I don't think you need an On Entry macro as well.
Sub optional_item1_Click()
Call cb_Click("optional_item1")
End Sub
Sub cb_Click(ffname As String)
ActiveDocument.Variables(ffname) = abs(int(ActiveDocument.FormFields(ffname).Checkbox.Value))
End Sub
In your Summa column, next to the checkbox, something like
{ ={ DOCVARAIABLE optional_item1 }*X2 }
where X2 is the cell that contains the 3,00 Euro value and all the { } are the special field code brace pairs that you can insert using ctrl-F9 on Windows Word.
BUT
Whether Word will correctly interpret your Euro value correctly depends on the regional settings of the user using your form, (decimal separator, group (thousands) separator, currency symbol and location of the currency symbol may all change Word's behaviour. Even within the Eurozone I think some of those things can vary. So if the user does not need to modify the multiplier 3,00 Euros in the cell, it may be better to plug the value directly into the { = } field:
{ ={ DOCVARAIABLE optional_item1 }*3 }
You can also use \# numeric formats to give you the format you want when positive or 0. But again, Word's numeric formatting facility is not locale-independent).
Those locale dependencies are also sometimes a reason for doing more in VBA rather than field codes.
As AdamsTips found out elsewhere, replacing this
ActiveDocument.FormFields("myField").Result
by this
ActiveDocument.Bookmarks("myField").Range.Fields(1).Result
allows accessing the field without focusing it.