So currently, I've adapted code that I got from Allen Brown to duplicate reports rather than forms. Basically I'm able to pass my criteria for the report with no problem and I can create a number of reports with the different criteria.
My problem is that each report may need to be saved, printed, or emailed to a user. But what happens is that the object that was opened first is the only thing that will be saved or emailed but when I print using the simple code DoCmd.PrintOut acPrintAll each object will take on the respective criteria. I need to figure out a way to be able to save and email these objects.
The reports are distinguishable by the HWND property that is set to it. The code I have is this currently:
Public clnClient As New Collection 'Instances of rptClient.
'Purpose: Open an independent instance of each Report with seperate criteria
Dim rpt As Report
'Open a new instance, show it, and set a caption.
If strReport = "rptInvoices" Then
Set rpt = New Report_rptInvoices
ElseIf strReport = "rptExpense" Then
Set rpt = New Report_rptExpense
ElseIf strReport = "rptExpensesDetailed" Then
Set rpt = New Report_rptExpenseDetailed
ElseIf strReport = "rptInvoicesDetailed" Then
Set rpt = New Report_rptInvoicesDetailed
ElseIf strReport = "rptPuchaseOrder" Then
Set rpt = New Report_rptPuchaseOrder
ElseIf strReport = "rptPurchaseOrderDetail" Then
Set rpt = New Report_rptPurchaseOrderDetail
ElseIf strReport = "TotalSalesForYear" Then
Set rpt = New Report_TotalSalesForYear
ElseIf strReport = "TotalShipped" Then
Set rpt = New Report_TotalShipped
ElseIf strReport = "TotalShippedDetailed" Then
Set rpt = New Report_TotalShippedDetailed
ElseIf strReport = "rptShipActual" Then
Set rpt = New Report_rptShipActual
ElseIf strReport = "rptSearchResults" Then
Set rpt = New Report_rptSearchResults
ElseIf strReport = "rptKTNA" Then
Set rpt = New Report_rptKTNA
ElseIf strReport = "rptFourWeek" Then
Set rpt = New Report_rptFourWeek
ElseIf strReport = "rptBalance" Then
Set rpt = New Report_rptBalance
ElseIf strReport = "Bosch_Report" Then
Set rpt = New Report_Bosch_Report
ElseIf strReport = "rptQuotes" Then
Set rpt = New Report_rptQuotes
End If
rpt.Visible = True
rpt.Filter = strWhereDate
rpt.FilterOn = True
rpt.Caption = rpt.Hwnd & ", opened " & Now()
rpt.txtCalledFrom = rpt.Hwnd
'Append it to our collection.
clnClient.Add Item:=rpt, Key:=CStr(rpt.Hwnd)
Set rpt = Nothing
strReport is the name of the report and strWhereDate is what is being used for the time interval. There is also code not listed here that removes the rpt.hwnd from the collection when a report closes.
The report manager that passes the criteria was adapted from Gaining Access
I'm wondering if a dictionary would work better than a collection but I've tried adapting the code and I can't seem to get it working properly, I know that dictionary's can reference objects. I've also tried this bit of code:
sRep = Screen.ActiveReport.Hwnd
DoCmd.OutputTo acOutputReport, sRep, acFormatPDF
which does accurately find the hwnd and it even opens up the dialog to save it to a location using the name hwnd.pdf but I'm afraid that it doesn't appear after you save it. I am assuming the object is technically not there?
If you try to tackle this problem, know that I'm a novice. Please help!!!
Related
I need to create a dynamic (on the fly) report, because the number and names of fields will change frequently. I have it all worked out except I cannot figure out how to create a group header based upon a field name.
Here was my first try, which returns "The number you used to refer to the form or report section is invalid."
Dim rpt as Report
dim txtNew as Access.Textbox
set rpt = CreateReport
With rpt
.Width = 8500
.RecordSource = "IS_Subscales_GB_Final"
End With
Set txtNew = CreateReportControl(rpt.Name, acTextBox, acGroupLevel1Header, , "FriendlyName01", 0, 0)
txtNew.FontBold = True
txtNew.FontSize = 16
txtNew.SizeToFit
DoCmd.OpenReport rpt.Name, acViewPreview
So I next tried to use CreateGroupLevel, but this returns the error "You can't call this function when the Group, Sort, and Total Pane is open."
Dim rpt as Report
dim txtnew as Access.Textbox
Dim vargrplvl As Variant
set rpt = CreateReport
With rpt
.Width = 8500
.RecordSource = "IS_Subscales_GB_Final"
End With
vargrplvl = CreateGroupLevel(rpt.Name, "FriendlyName", True, False)
rpt.Section(acGroupLevel1Header).Height = 400
Set txtNew = CreateReportControl(rpt.Name, acTextBox, acGroupLevel1Header, , "FriendlyName01", 0, 0)
txtNew.FontBold = True
txtNew.FontSize = 16
txtNew.SizeToFit
DoCmd.OpenReport rpt.Name, acViewPreview
Any guidance would be appreciated.
I made multiple mistakes but also, Access has a quirk where it unexpectedly throws the 2451 error ("You can't call this function when the Group, Sort, and Total Pane is open.")---this happens only if the last time you were in Design view for a report, you had the Group, Sort, and Total Pane open. Access saves that setting so you either need to go back into a report in Design view and turn the panel off, or use an error handler to work around it. So here is a learning lesson coming from the whole ordeal:
Dim rpt as Report
Dim vargrplevel As Variant 'holds grouping level of report
Dim txtNew as Access.Textbox ' textbox control
Dim lblNew As Access.Label ' label control
set rpt = CreateReport 'creates a report object
with rpt
.width = 8500 'sets width of report
.RecordSource = "IS_Subscales_GB_Final" ' your table or query
end with
'start setting your controls on the report using CreateReportControl, i.e.:
Set lblNew = CreateReportControl(rpt.Name, acLabel, acDetail, , , 2700, 0, 270, 315)
lblNew.Caption = "O"
lblNew.FontSize = 12
lblNew.FontBold = True
'To add a group level to the report, it MUST be in acViewDesign!
DoCmd.OpenReport rpt.Name, acViewDesign
On Error GoTo ErrorHandler
'if the Group, Sort, and Total pane was left "on" then this next line will throw error 2451
vargrplevel = CreateGroupLevel(rpt.Name, "FriendlyName01", True, False) 'Creates a group header, named "FriendlyName01"
rpt.Section(acGroupLevel1Header).Height = 400 'optional; sets the header height
Set txtNew = CreateReportControl(rpt.Name, acTextBox, acGroupLevel1Header, , "FriendlyName01", 0, 0) 'This actually inserts the field into the header as textbox control
txtNew.FontBold = True
txtNew.FontSize = 16
DoCmd.Save acReport, rpt.Name
Exit Sub
ErrorHandler:
If Err.Number = 2154 Then
RunCommand acCmdSortingAndGrouping 'turns off the Sorting and Grouping pane
Resume
Else
Debug.Print "Error in creating report header (EH01- " & Err.Number & ")"
Exit Sub
End If
Cheers.
I am new to programming in VBA. I am trying to copy Form data from an existing form when I click on the Copy Record button. This is supposed to copy the current form data as a new record with a new master_id (that is autonumbered) and have Brand as blank field for them to fill in. I get a:
Run Time Error 3265 "Item not found in this collection"
at the new_master_id that i created. I am not sure how to fix this problem. Any help is appreciated.
Private Sub Copy_Record_Click()
Dim RS As DAO.Recordset, C As Control
Dim FillFields As String, FillAllFields As Integer
Dim New_MASTER_ID As Integer
New_MASTER_ID = (DMax("[MASTER_ID]", "tbl_Drug_Master") + 1)
Dim BRAND As String
BRAND = ""
Set RS = CurrentDb.OpenRecordset(Name:="tbl_Drug_Master", Type:=RecordsetTypeEnum.dbOpenDynaset)
With RS
.AddNew
![MASTER_ID] = ![New_MASTER_ID] <--this is where the problem is...
![MASTER_KEY] = Me![MASTER_KEY]
![PRODUCT_CATEGORY] = Me![PRODUCT_CATEGORY]
![BRAND] = Me![BRAND]
![GENERIC] = Me![GENERIC]
![STUDY_NAME] = Me![STUDY_NAME]
![MANUFACTURER] = Me![MANUFACTURER]
![MASTER_COMMENTS] = Me![MASTER_COMMENTS]
.Update
End With
End Sub
ok so firstly, im not sure why the following are required:
dim c as control
Dim FillFields As String, FillAllFields As Integer
New_MASTER_ID = (DMax("[MASTER_ID]", "tbl_Drug_Master") + 1)
Dim BRAND As String
BRAND = ""
therefore I am leaving them out as part of this question because they appear unnecessary. Brand is not required because you are creating a new record and putting nothing in the brand field so it will remain blank.
I am also not too sure why you have 2 tables both that are the same? I think what should happen is that you simply copy the data to a new record in the same table.
You will see I have put a save record command in to the routine. other additions such as error handling is also recommended.
Private Sub Copy_Record_Click()
docmd.runcommand accmdsaverecord
Dim RS As Recordset
Set RS = CurrentDb.OpenRecordset(Name:="tbl_Drug_Master", Type:=RecordsetTypeEnum.dbOpenDynaset)
With RS
.AddNew
![MASTER_KEY] = Me.MASTER_KEY.value
![PRODUCT_CATEGORY] = Me.PRODUCT_CATEGORY.value
![GENERIC] = Me.GENERIC.value
![STUDY_NAME] = Me.STUDY_NAME.value
![MANUFACTURER] = Me.MANUFACTURER.value
![MASTER_COMMENTS] = Me.MASTER_COMMENTS.value
.Update
End With
Set RS = Nothing
End Sub
I was mistaken with my comment rs.close it would be db.close but you are using the currentdb and no reason to close it. This procedure will remain on the original record, if you want to go to the new record you will have to add a command like docmd.gotorecord acdataform, , aclast before the end of the routine.
I have designed a report using Telerik Report Designer 2013 Q3 and added it in my project folder. Now i need to load it with available parameters for the report
For that i used the code as below
Private Sub DeserialiseXmlAndGenerateReport(strFilePath As String)
Dim settings As New XmlReaderSettings()
settings.IgnoreWhitespace = True
Dim myReportBook As Telerik.Reporting.ReportBook = New Telerik.Reporting.ReportBook
Using xmlReader As System.Xml.XmlReader = System.Xml.XmlReader.Create(Server.MapPath(strFilePath), settings)
Dim xmlSerializer As New Telerik.Reporting.XmlSerialization.ReportXmlSerializer()
Dim reportWMS As Telerik.Reporting.Report = DirectCast(xmlSerializer.Deserialize(xmlReader), Telerik.Reporting.Report)
With reportWMS
.DocumentMapText = ""
.ReportParameters("projectNo").Value = _projectNo
.ReportParameters("dnHeaderNo").Value = _value
.ReportParameters("transferType").Value = _TransferType
ReportViewer1.DocumentMapVisible = False
ReportViewer1.ShowDocumentMapButton = False
End With
myReportBook.Reports.Add(reportWMS)
End Using
Dim reportSource = New Telerik.Reporting.InstanceReportSource
reportSource.ReportDocument = myReportBook
ReportViewer1.ReportSource = reportSource
ReportViewer1.RefreshReport()
End Sub
All the values for report parameters are supplied. But not getting any output. There is no exception fired. But a blank screen with a toolbar only gets loaded. Please help me
In Access, I have a table which contain a field like this:
Part Number
A/B/C
A/B/R
T/Y/V
D/A/I
I want to change the color of the all the third part to red. So in this case C,R,V,I will be colored red. But I can't do change the color of part of the text field in Access 2007. If I use Font Change under Home tab it change the Font of entire Table. I'm so disappointed about Microsoft. Is there any way to change the color would be great :D You can recommend VBA , Macro in Form, Query, Report ...
P/S: I use Access 2007
if you can use an Access report, you can add a TextBox to the report. In the textbox, you can have a formula like this:
="<font color=""blue"">" & [ColumnA] & "</font> <u>" & [ColumnB] & "</u>"
See Access Rich-Text: Which subset of HTML is supported? for more details.
ok I think the only way is to export automatically to Excel. Finally I can do this
Private Sub CommandExport_Click()
Dim db As Database
Dim rec1 As Recordset
Dim xlFile As Object
Dim xlWorkBook As Object
Dim xlActiveWkb As Object
Dim xlActiveSheet As Object
Dim iCols, iRows, flag As Integer
Set db = CurrentDb
Set xlFile = CreateObject("Excel.Application")
Set xlWorkBook = xlFile.Workbooks.Add
Set xlActiveWkb = xlFile.Application.ActiveWorkBook
xlFile.Visible = True
xlActiveWkb.Sheets.Add
xlActiveWkb.Worksheets(1).Name = "My_Report"
Set xlActiveSheet = xlActiveWkb.Worksheets("My_Report")
Set rec1 = db.OpenRecordset("Report")
For iCols = 0 To rec1.Fields.Count - 1
xlActiveSheet.Cells(1, iCols + 1).Value = rec1.Fields(iCols).Name
If rec1.Fields(iCols).Name = "FS Number" Then
flag = iCols
End If
Next
xlActiveSheet.Range(xlActiveSheet.Cells(1, 1), xlActiveSheet.Cells(1, rec1.Fields.Count)).Font.Bold = True
xlActiveSheet.Range(xlActiveSheet.Cells(1, 1), xlActiveSheet.Cells(1, rec1.Fields.Count)).Interior.ColorIndex = 15
xlActiveSheet.Cells(2, 1).CopyFromRecordset rec1
xlActiveSheet.Columns("A:AD").EntireColumn.AutoFit
iRows = 1
rec1.MoveFirst
While Not rec1.EOF
xlActiveSheet.Cells(iRows + 1, flag + 1).Characters(InStr(rec1![FS Number], "*")).Font.ColorIndex = 3
iRows = iRows + 1
rec1.MoveNext
Wend
Set xlSheet = Nothing
Set xlWorkBook = Nothing
Set xlActiveWkb = Nothing
rec1.Close
db.Close
Set rec1 = Nothing
Set db = Nothing
End Sub
The magic is here
xlActiveSheet.Cells(iRows + 1, flag + 1).Characters(InStr(rec1![FS Number], "*")).Font.ColorIndex = 3
I have a Subform/Subreport control displayed on a Form in an Access 2010 database, and I use it to display both Forms and Reports. I have a few event handlers in which I need to know whether a Report is currently loaded into the Subform/Subreport control, or if it's a Form that's loaded. I have tried all of the following to no avail.
Any of the following conditions
If IsEmpty(NavigationSubform.Form) Then '...
If IsNull(NavigationSubform.Form) Then '...
If IsOject(NavigationSubform.Form) Then '...
If NavigationSubform.Form Is Nothing Then '...
If NavigationSubform.Form Is Null Then '...
If Nz(NavigationSubform.Form) Then '...
If (Not NavigationSubform.Form) = -1 Then '... This is a trick I use to check for uninitialized arrays
Results in
Run-time error '2467':
The expression you entered refers to an object that is closed or doesn't exist.
Is there some way that I can check whether a Subform/Subreport control currently has a Form or Report loaded without intentionally causing an error?
I don't believe that there is a way to reliably perform the check without error trapping, so you may want to wrap the code in a Public Function and put it into a regular VBA Module:
Public Function CheckSubformControlContents(ctl As SubForm) As String
Dim obj As Object, rtn As String
rtn = "None"
On Error Resume Next
Set obj = ctl.Form
If Err.Number = 0 Then
rtn = "Form"
Else
On Error Resume Next
Set obj = ctl.Report
If Err.Number = 0 Then
rtn = "Report"
End If
End If
Set obj = Nothing
On Error GoTo 0
CheckSubformControlContents = rtn
End Function
Then your form code can simply call CheckSubformControlContents(Me.NavigationSubform).
Here are two functions that work in Access 2013 for determining if a name is a Report or a Form.
Once that is determined the IsLoaded function of AllForms or AllReports can be used. Note that dbs is an object and rpt or frm are AccessObjects not forms or reports
Public Function IsForm(FormName As String) As Boolean
Dim dbs As Object
Dim frm As AccessObject
Set dbs = Application.CurrentProject
IsForm = False
For Each frm In Application.CurrentProject.AllForms
If frm.Name = FormName Then
IsForm = True
Exit For
End If
Next frm
Set frm = Nothing
Set dbs = Nothing
End Function
Public Function IsReport(ReportName As String) As Boolean
Dim dbs As Object
Dim rpt As AccessObject
Set dbs = Application.CurrentProject
IsReport = False
For Each rpt In Application.CurrentProject.AllReports
If rpt.Name = ReportName Then
IsReport = True
Exit For
End If
Next rpt
Set rpt = Nothing
Set dbs = Nothing
End Function
Here is a program that uses the above functions:
Public Sub EnumerateTaggedControls(ReportName As String, MyTag As String)
Dim dbs As Object
Dim rpt As Report
Dim frm As Form
Dim col As Controls
Dim ctl As Control
Dim left As Integer
Dim top As Integer
Dim width As Integer
Dim height As Integer
Dim tag As String
Dim i As Integer
Const format1 As String = "0000 "
Set dbs = Application.CurrentProject
If IsForm(ReportName) Then
If dbs.AllForms(ReportName).IsLoaded Then
DoCmd.OpenForm ReportName, acViewDesign
Set frm = Forms(ReportName)
Set col = frm.Controls
End If
Else
If dbs.AllReports(ReportName).IsLoaded Then
DoCmd.OpenReport ReportName, acViewDesign
Set rpt = Reports(ReportName)
Set col = rpt.Controls
Else
Debug.Print ReportName & " is not a loaded form or report."
Exit Sub
End If
End If
Set dbs = Nothing
Debug.Print Tab(53); "Left Top Width Height"
For Each ctl In col
With ctl
left = .Properties("Left")
top = .Properties("Top")
width = .Properties("Width")
height = .Properties("Height")
tag = Nz(.Properties("Tag"), vbNullString)
If MyTag = "" Then
i = 1
Else
i = InStr(1, tag, MyTag)
End If
If i > 0 Then
Debug.Print .Name & ">"; Tab(33); tag; Tab(53); Format(left, format1) & Format(top, format1) & Format(width, format1) & Format(height, format1)
End If
End With
Next ctl
Debug.Print "====================================================="
Set ctl = Nothing
Set rpt = Nothing
Set col = Nothing
Set frm = Nothing
End Sub
I hope this meets your requirements.