Make a continuous form set its height automatically - ms-access

I am trying to make a continuous form set its height to equal the height of the Header + height of Footer + height of the Detail. This is to avoid having a form with only two or three records have a large amount of blank space. Conversely I want to have a large number of records appear on a form with 10 records per page and arrow Down/Up to see the rest of the records.
These are the procedures I set up:
Public Function NumRecs() As Integer
NumRecs = DCount("*", "tblDisclosure", "Not IsNull(FormSentOff) and IsNull(DBSInvoice))
End Function
Public Function FrmHt() As Integer
Dim FrmDet As Integer
Dim FrmHdr As Integer
Dim FrmFtr As Integer
FrmDet = Form.Section(0).Height
FrmHdr = Form.Section(1).Height
FrmFtr = Form.Section(2).Height
If FrmHt > (11 * FrmDet + FrmHdr + FrmFtr) Then
FrmHt = 11 * FrmDet + FrmHdr + FrmFtr
Else
FrmHt = (NumRecs * FrmDet) + FrmHdr + FrmFtr + FrmDet
End If
End Function
Private Sub Form_Load()
Me.Move Left:=8000, Top:=1000, Width:=9240, Height:=FrmHt
End Sub
It ignores the If…Then… Else statement and creates a form showing all records in one window
which is unmanageable.
It works for a form of less than 11 records (obviously) but I find that I have to add in the height
of an extra record otherwise it puts the last record on a second page. Viz:
FrmHt = (NumRecs * FrmDet) + FrmHdr + FrmFtr + FrmDet
I can live with this but I would really like to resolve the problem of the If…Then…Else statement being ignored.
I have changed the type casting to Variant and Double but this made no difference.

There seems to be an issue your code: you use FrmHt in your If statement, but it has no value at that point, it will always be 0.
I think you probably want your statement to be something like:
If NumRecs > 11 Then
FrmHt = 11 * FrmDet + FrmHdr + FrmFtr
Else
FrmHt = (NumRecs * FrmDet) + FrmHdr + FrmFtr + FrmDet
End If
The other issue of the last record being on the next page may be because you're too tight in displaying the 10 records on screen and during the conversion from twips to pixels rounding errors may make the total height a tiny bit less than what would be necessary for 10 records.
Try adding a few twips to your FrmHT result to see if this works.

Related

Access: Increment/Decrement a number with 2 dots

I have two fields for current version number and previous version number in a form. What I want to do is when I enter the current version number (which is written like this 18.04.15), the previous version number on the next text box to automatically fill itself with 18.04.14.
I tried:
=[txtCurrentVersion]-1 in the control source, but obviously because I'm not decrementing by one, it didn't work.
Would appreciate some guidance, thanks :)
Below code splits the text based on dot and subracts one from last item.
Private Sub txtCurrentVersion_AfterUpdate()
If Nz(Me.txtCurrentVersion, "") <> "" Then
Me.txtPrevVersion.Value = Split(Me.txtCurrentVersion, ".")(0) & "." & Split(Me.txtCurrentVersion, ".")(1) & "." & Split(Me.txtCurrentVersion, ".")(2) - 1
End If
End Sub
I would suggest creating a function where you give the function 3 parameters, the 1st is the current version number string, the 2nd is the version number level (0 for major number, 1 for subversion number and 2 for minor version number) and the value to increase or decrease.
for example:
Function ModifyVersion(VersionNumber, NumberLevel, Number)
If VersionNumber <> "" AND NumberLevel >= 0 AND NumberLevel < 3 Then
dim VersionArray
VersionArray = Split(VersionNumber, ".")
Select Case NumberLevel
Case 0
VersionArray(0) = VersionArray(0) + Number
Case 1
VersionArray(1) = VersionArray(1) + Number
Case 2
VersionArray(2) = VersionArray(2) + Number
End Select
ModifyVersion = VersionArray(0) & "." & VersionArray(1) & "." & VersionArray(2)
End If
End Function
Then to decrease one from the minor version number use:
VersionNumber = [txtCurrentVersion]
Dim UpdateVersion
UpdateVersion = ModifyVersion(VersionNumber, 2, -1)

Compare index of 2 elements in a collection

Issue : I have some issues figuring out a way to select elements in my HTMLDocument which are under a certain point in the page.
In the following code sample, as you can see in the comments, I first select a part of them which respect my queryselector criteria
IEDoc.querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']")
In this example I have 10 elements in this collection. Each of this element in contained in a table which is its parent on the 7th degree.
MsgBox TypeName(IEDoc.querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']")(2).ParentNode.ParentNode.ParentNode.ParentNode.ParentNode.ParentNode.ParentNode) ' HTMLTable
Some of those elements are in the same table.
You can see here the form which contains all the tables .
Now, the thing is that I want to select the innerHTML of some of those elements only and not all of them. The criterion to know if I one of those 10 elements interests me or not is it's position on the webpage. I want all the elements which are under the message Part Usage. There is only one table containing the Part Usage text and so my idea was to see if the table in which are contained each element has a higher or lower index in the "form" collection.
If the index is higher I want this element, otherwise I discard it.
What I did for this is the following code :
I set the ID Bim to all the tables containing one or more
from the 10 elements.
For Each Element In IEDoc.querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']") ' here for all of the 10 numbers found with the queryselectorall we'll find their respective table in the collection (form) and set its Class as "Bim". But since some of the numbers are in the same table, we won't have 10 tables with a classname "Bim" at the end of the process. We'll have only x tables with the classname "Bim"
Element.ParentNode.ParentNode.ParentNode.ParentNode.ParentNode.ParentNode.ParentNode.Class = "Bim"
Next
I set the ID Stop to the table containing the text Part Usage
For Each Element In IEDoc.getElementsByClassName("SectionHead")
If Element.innerHTML = "Part Usage" Then
'MsgBox TypeName(Element.ParentNode.ParentNode.ParentNode)' HTMLTable
Element.ParentNode.ParentNode.ParentNode.ID = "Stop"
End If
Next
I check which tables with the Classname Bim are under (=higher index) the table with the ID Stop. For the table ( there is actually only one) matching the criterion of point 3 I apply IEDoc.querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']") inside of them so that I get all the elements in contains and more paricularly their innerHTML.
For Each Element In IEDoc.getElementsByClassName("Bim") ' Here we check all the x tables which have the Classname "Bim"
If Element.indexInTheWholeForm > IEDoc.getElementById("Stop").indexInTheWholeForm Then 'and compare somehow if their index in the (form) collection if higher than the table with the ID "Stop" ( this is similar to checking if the element if lower on the webpage in thic case) ( we only want the element which have a higher index aka under the Part Usage table)
For Each Element2 In Element.querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']") ' Now we are in the table which contains the part numbers and we'll look for all the part numbers it contains by applying the queryselectorall again, but this time only in this specific table
array_parts2(iteration2) = Element.querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']")(iteration2).innerHTML
ActiveWorkbook.Worksheets(1).Cells(iteration2 + 1, 19) = array_parts2(iteration2)
iteration2 = iteration2 + 1
Next
End If
Next
of course what doesn't work is the indexInTheWholeForm property which doesn't exist. Any ideas on how to do this ?
Thank for reaching that line :)
Untested but I would do something like this (assuming I understood you correctly)
Sub Tester()
Const S_MATCH As String = "td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']"
Dim e, tbl, bHit As Boolean
'...
'load page etc
'...
'get all the matching rows and cycle though them
For Each e In IEDoc.querySelectorAll(S_MATCH)
'did we get to the table of interest yet?
If Not bHit Then
Set tbl = e.ParentNode.ParentNode.ParentNode.ParentNode. _
ParentNode.ParentNode.ParentNode
If IsPartUsageTable(tbl) Then bHit = True
End If
If bHit Then
'we reached the table of interest, so
' do something with e
End If
Next
End Sub
Function IsPartUsageTable(tbl) As Boolean
Dim e, rv As Boolean
For Each e In tbl.getElementsByClassName("SectionHead")
If Element.innerHTML = "Part Usage" Then
rv = True
Exit For
End If
Next
IsPartUsageTable = rv
End Function
Ok, so as unexpected as it sounds, I think I found a solution to my own question. I will confirm you that it works as soon as I have the possibility to run it with my colleague.
So I keep point 1 and 2 from my initial post and I replaced point 3 with the following :
For i = 0 To IEDoc.getElementsByTagName("form")(0).getElementsByTagName("table").length
If IEDoc.getElementsByTagName("form")(0).getElementsByTagName("table")(i).ID = "Stop" Then
index_Part_Usage = i
Position_Part_Usage = index + 1
Exit For
End If
Next
'MsgBox Position_Part_Usage
For i = 0 To IEDoc.getElementsByTagName("form")(0).getElementsByTagName("table").length
If IEDoc.getElementsByTagName("form")(0).getElementsByTagName("table")(i).className = "Bim" Then
index = i
Position = index + 1
If index > index_Part_Usage Then
For Each Element2 In IEDoc.getElementsByTagName("form")(0).getElementsByTagName("table")(i).querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']") ' Now we are in the table which contains the part numbers and we'll look for all the part numbers it contains by applying the queryselectorall again, but this time only in this specific table
array_parts2(iteration2) = IEDoc.getElementsByTagName("form")(0).getElementsByTagName("table")(i).querySelectorAll("td[width='100'][class='ListMainCent'][rowSpan='1'][colSpan='1']")(iteration2).innerHTML
ActiveWorkbook.Worksheets(1).Cells(iteration2 + 1, 19) = array_parts2(iteration2)
iteration2 = iteration2 + 1
Next
End If
End If
Next i

calculation in VBA

have an access database with a form that has multiple textboxes for production data. I need to do a calculation with a few of the boxes, they are set up as
txtA * txtB * txtC = txtD
I need to take the values from each of the boxes and perform this calculation behind the scenes. So I need the value from txtA * txtB * txtC and display the answer to that calculation in txtD. I keep running into issues because of the number of textboxes on my form it will always pick up the wrong data?? HeLP!
Private Sub btnCalculate_Click()
Dim ctrl As Control
Dim txt As TextBox
For Each ctrl In Form.Controls
If TypeOf ctrl Is TextBox Then
Set txt = ctrl
If txt.Name = "txtD" Then
Set txt = ctrl
ctrl.SetFocus
ctrl.Text = calculate
End If
End If
Next ctrl
End Sub
Public Function calculate()
Dim calc1 As Double
calc1 = txtA.Value * txtB.Value * txtC.Value / 144
End Function
I keep getting this error:
Run-time error '2185':
You can't reference a property or mathod for a control unless the control has the focus.
This is in regards to txtA, txtB, txtC.
Try
txtD = calculate()
Or
Me!txtD = calculate()
If, for some reason, you want to access a control by its name, do it like this
Dim name As String
name = "txtD"
Me(name) = calculate()
Your calculation function must assign the result to the function name. A potential problem is that you are ignoring types. Of which type is the result of the function? It will be typed as Variant if you don't specify a type (and a variant can contain about anything). Better
Public Function calculate() As Double
calculate = CDbl(txtA.Value) * CDbl(txtB.Value) * CDbl(txtC.Value) / 144
End Function
Now, everyone who looks at the function knows what kind of data the textboxes should contain and, more important, what kind of result the function returns.
First off, the line
ctrl.Text = calculate
should be
ctrl.Text = calculateBoardFeet()
Next, the code
calc1 = txtA.Value * txtB.Value * txtC.Value / 144
should be
calculateBoardFeet = txtA.Value * txtB.Value * txtC.Value / 144

Access VBA - How is this code grouping all info for one policy together?

So, I inherited some code (below) from someone else and I'm trying to understand how it works. I understand msot of the code (though I'm pretty new to Access VBA) but the one part I don't get is how this code groups all the info for one policy together.
The situation is as follows. To get premium data for a specific policy, from our company database, we have to get it one coverage per line. But, I want all premiums, one for each coverage, all on the same line. So, this code puts it all together from many lines into one line. For simplicity, I knocked it down to 3 total coverages, though there are many more. As I read the code, it seems to assume that all the info for one policy is together, like the 1, 2, or 3 rows for a specific policy are in order. But, even when I, for example, order the table by the premium (amount) column, it still gets all the premium for one policy on one line. I don't see anywhere in the code that should make this work. The code is comparing the policy number on one line to the policy number on the next. If they are the same, group the premium together. If they are different, don't. Again, I could order the table so that the records for one policy are not together, but the end result still comes out right. Am I missing something? Is it something in Access doing it? Thanks for any help!
Option Compare Database
Option Explicit
' Premium is imported with one row for each coverage per policy, so possibly several rows per policy.
' This procedure takes several rows per policy and makes them into one row.
Sub ScrubPremium()
Dim i As Long, j As Long, k As Long
Dim NumRecords As Long, found As Long, UniqueCount As Long
Dim tempPolicyNum As String, tempCoverage As String, tempPremium As Single
Dim PolicyNumArray() As String, PremiumArray() As Single, TotalPremiumArray() As Single
Dim db As DAO.Database
Set db = CurrentDb
Dim infile As Variant, outfile As Variant
Set infile = db.OpenRecordset("Imported Premium")
CurrentDb.Execute "DELETE * FROM [Finalized Premium]"
Set outfile = db.OpenRecordset("Finalized Premium")
NumRecords = infile.RecordCount
ReDim PolicyNumArray(NumRecords)
ReDim PremiumArray(NumRecords, 3)
ReDim TotalPremiumArray(NumRecords)
infile.MoveFirst
'initialize PremiumArray
For i = 1 To NumRecords
For j = 1 To NumPremiums
PremiumArray(i, j) = 0
Next j
Next i
'populate arrays
UniqueCount = 0
For i = 1 To NumRecords
tempPolicyNum = infile![Policy_Number]
tempCoverage = infile![Coverage]
tempPremium = infile![Premium]
k = 0
found = 0
Do Until k = UniqueCount Or found = 1 'check for unique policy
If tempPolicyNum = PolicyNumArray(k + 1) Then
found = 1
Else
k = k + 1
End If
Loop
If found = 0 Then
UniqueCount = UniqueCount + 1
PolicyNumArray(k + 1) = tempPolicyNum
End If
Select Case tempCoverage
Case "Comprehensive"
j = 1
Case "Collision"
j = 2
Case Else
j = 3
End Select
PremiumArray(k + 1, j) = PremiumArray(k + 1, j) + tempPremium
TotalPremiumArray(k + 1) = TotalPremiumArray(k + 1) + tempPremium
infile.MoveNext
Next i
'Populate table
For i = 1 To UniqueCount
outfile.AddNew
outfile![Full Policy Number] = PolicyNumArray(i)
outfile![Comp Premium] = PremiumArray(i, 1)
outfile![Coll Premium] = PremiumArray(i, 2)
outfile![Other Premium] = PremiumArray(i, 3)
outfile![Total Premium] = TotalPremiumArray(i)
outfile.Update
Next i
infile.Close
outfile.Close
End Sub
The code is comparing the policy number on one line to the policy
number on the next. If they are the same, group the premium together.
If they are different, don't.
Almost.
There are two loops here. One walks through each row of your input file. On each row of the input file, a second loop walks through (potentially all of) PolicyNumArray, looking for policy numbers that match the number taken from the input file.
If I were you, I'd step through this with the debugger. Make sure it's doing what you expect it to do. I'd want to look closely at this part (some lines snipped).
UniqueCount = 0
For i = 1 To NumRecords
k = 0
Do Until k = UniqueCount

SSRS code variable resetting on new page

In SSRS 2008 I am trying to maintain a SUM of SUMs on a group using custom Code. The reason is that I have a table of data, grouped and returning SUMs of the data. I have a filter on the group to remove lines where group sums are zero. Everything works except I'm running into problems with the group totals - it should be summing the visible group totals but is instead summing the entire dataset. There's tons of articles about how to work around this, usually using custom code. I've made custom functions and variables to maintain a counter:
Public Dim GroupMedTotal as Integer
Public Dim GrandMedTotal as Integer
Public Function CalcMedTotal(ThisValue as Integer) as Integer
GroupMedTotal = GroupMedTotal + ThisValue
GrandMedTotal = GrandMedTotal + ThisValue
Return ThisValue
End Function
Public Function ReturnMedSubtotal() as Integer
Dim ThisValue as Integer = GroupMedTotal
GroupMedTotal = 0
Return ThisValue
End Function
Basically CalcMedTotal is fed a SUM of a group, and maintains a running total of that sum. Then in the group total line I output ReturnMedSubtotal which is supposed to give me the accumulated total and reset it for the next group. This actually works great, EXCEPT - it is resetting the GroupMedTotal value on each page break. I don't have page breaks explicitly set, it's just the natural break in the SSRS viewer. And if I export the results to Excel everything works and looks correctly.
If I output Code.GroupMedTotal on each group row, I see it count correctly, and then if a group spans multiple pages on the next page GroupMedTotal is reset and begins counting from zero again.
Any help in what's going on or how to work around this? Thanks!
Finally found the solution myself. Here it is, add Shared to the variable declarations:
Public Shared Dim GroupMedTotal as Integer
Public Shared Dim GrandMedTotal as Integer
Just changing the variables to shared won't work. If you set them to shared they'll be DOUBLED when you export to PDF / XLS / etc (because it just kept adding to the existing var). You have to do something like this:
Public Shared Dim grandTotal as Decimal
Public Shared Dim costCenterTotal as Decimal
Public Shared Dim workerTotal as Decimal
Public Shared Function Initialize()
grandTotal = 0
costCenterTotal = 0
workerTotal = 0
End Function
Public Function AddTotal(ByVal b AS Decimal) AS Decimal
grandTotal = grandTotal + b
costCenterTotal = costCenterTotal + b
workerTotal = workerTotal + b
return b
End Function
Public Function GetWorkerTotal()
Dim ret as Decimal = workerTotal
workerTotal = 0
return ret
End Function
Public Function GetCostCenterTotal()
Dim ret as Decimal = costCenterTotal
costCenterTotal = 0
return ret
End Function
Public Function GetGrandTotal()
Dim ret as Decimal = grandTotal
grandTotal= 0
return ret
End Function
I don't know where do you use this. but in your case, if I were you, I just use simple expression to check visibility of SUM
for example I'd use Right Click On Sum Box \ Select Expression \ then use IIF(SUM <> 0, sum. "")
It worked on every where and wont reset, in your case you have a Region and your code will reset in every region so you willface with serios isses if you don't change your way.