I am trying to use VBA to colour the series in a chart by matching the names of the series to a table containing the colour values for each series (tblTypes). My only problem is retrieving the names of the series, which I've consistently read is accessed by SeriesCollection(index).Name. The weird thing is, SeriesCollection() doesn't seem to be returning a Series object. Here's the relevant code:
Private Sub ReformatColoursByType(grphChart As Object)
Dim rs As DAO.Recordset
Dim iii As Integer
Dim objSeries As Series
Set rs = CurrentDb.OpenRecordset("tblTypes", RecordsetTypeEnum.dbOpenDynaset)
rs.MoveFirst
Do
For iii = 1 To grphChart.SeriesCollection.Count
Set objSeries = grphChart.SeriesCollection(iii) -- !!! This line is the problem !!! --
If objSeries.Name = rs!rwType Then
... formatting ...
End If
Next iii
rs.MoveNext
Loop Until rs.EOF
End Sub
The line highlighted above returns a "type mismatch" error - grphChart.SeriesCollection(iii) is not of type "Series" for some reason. What's gone wrong?
A couple of things that are wrong.
In your code grphChart is a ChartObject - a container for the chart, not the chart itself.
Instead use:
grphChart.Chart.SeriesCollection.Count
and
grphChart.Chart.SeriesCollection(iii)
The second problem is Dim objSeries As Series. You've tagged the question as Access and, I think, your code is referencing Excel.
If it's late binding then Access won't understand what a Series is - you need to define it as an Object.
Related
I'm building a simple form in MS Access with a listbox in which I want to display data that is stored in a MySQL Server table. I want two columns to display in the listbox.
I am able to display the first column with the additem property but the second column throws the run time error message 424 Object Required.
I have searched for hours in the web an in my books but I can't figure it out.
What is the problem?
Private Sub cmdSuchenVerantwortlich_Click()
Dim rsAuswahl As New ADODB.Recordset
Dim i As Long
If pConnectDB.State = adStateClosed Then
modConnectDB.Connect_To_DB
End If
Me.lstAuswahl.RowSourceType = "Value List"
'Clear Listbox
For i = Me.lstAuswahl.ListCount - 1 To 0 Step -1
Me.lstAuswahl.RemoveItem i
Next i
With rsAuswahl
.ActiveConnection = pConnectDB
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.Open Source:="select MATNR, AUSNAHME from Ausnahmeliste where VERANTWORTLICH = '" & Me.cboVerantwortlich & "' "
Do Until .EOF
Me.lstAuswahl.AddItem .Fields("MATNR").Value
Me.lstAuswahl.Column(1, Me.lstAuswahl.ListCount - 1) = .Fields("AUSNAHME").Value
.MoveNext
Loop
.Close
End With
End Sub
The code Me.lstAuswahl.Column(1, Me.lstAuswahl.ListCount - 1) = .Fields("AUSNAHME").Value throws the error messsage.
The data type in the MySQL table of MATNR and AUSNAHME is varchar.
When I hold the mouse over .Fields("MATNR").Value I can see the excpected value and holding the mouse over .Fields("AUSNAHME").Value I can see the expected value as well. So the data is the but what's wrong ?
Thanks for anybody's help.
To add values using the "AddItem" method of the listbox, you need to concatenate the values, separated by a comma, so a delimited string as below:
Make sure that the columncount of your listbox is set to 2, or however many columns you want displayed.
Me.lstAuswahl.AddItem .Fields("MATNR").Value & "," & .Fields("AUSNAHME").Value
If you are only adding a few records, this is probably okay, but if you are going to display a lot of rows, it maybe best to transfer the data to a local table in access, and then bound your listbox directly to the table/query local to access.
Good evening!
At this moment I'm learning to work in MS Access for my job purposes. I gained some understanding of the program's basics, such as creating tables or making easy forms (though not yet working ideally), and by now I've got stuck in solving the following task.
I have a database BooksDatabase, which consists of three tables: Books, Authors and AuthorsInfo. First one contains information about books (name, genre, country, release year etc.), third one is about authors (first name, last name etc.) and the second one links ever book with its author(s). The task is to import data from text file to those tables, so that it would be almost automatic. I understand how to import files to MS Access (at least, the ones of *.txt extension) and I do this into the table BooksToImport, but I have some difficulties with inserting imported data. Here is the code of my function ImportBooks(), which I execute from macros of the same name:
' Procedure which imports data about books from the table BooksToImport
Function ImportBooks()
Dim dbBooks As Database
Dim rstImBooks, rstBooks, rstAuthors, rstBALink As DAO.Recordset
Dim codeI, codeB, codeA, codeL As Variant
'initializing database
Set dbBooks = CurrentDb
Set rstImBooks = dbBooks.OpenRecordset("Query_BooksToImport",dbOpenDynaset) 'receiving data from query
'checking if the query has any records
If rstImBooks.RecordCount = 0 Then
MsgBox "There are no records for importing!", vbInformation, "Attention!"
rstImBooks.Close
Set dbBooks = Nothing
Exit Function
End If
'if it's OK, we're making a loop on query's records
rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
rstImBooks.MoveLast
rstImBooks.MoveFirst
Do While rstImBooks.EOF = False
'checking if there is a book in out database with the same name as in imported data
codeB = DLookup("[ID]","[Books]","[BookName] = '" & rstImBooks![BookName] & "'")
If IsNull(codeB) Then
'inserting new record
With rstBooks
.AddNew
![BookName] = rstImBooks![BookName]
.Update
.Bookmark = .LastModified
codeB = ![ID]
End With
End If
'in much the same way we're treating the data about authors and making the links
rstImBooks.MoveNext
Loop
rstImBooks.Close
rstBooks.Close
rstAuthors.Close
rstBALink.Close
Set dbBooks = Nothing
End Function
I have two problems with this function:
method .AddNew for rstBooks is not working — MS Access shows me a message with error 438 ("Object doesn't support this property or method");
also I cannot assign variable rstBALink to the recordset because compiler says "Invalid use of property".
So my question is this: how should I solve these two problems? What do I do wrong that my function is not working properly?
A few issues with your code that I see. These may or may not fix your problem.
Your declarations are implicit, meaning you aren't being specific with your code about what your recordset objects are. Instead of using:
Dim rstImBooks, rstBooks, rstAuthors, rstBALink As DAO.Recordset
Try:
Dim rstImBooks As DAO.Recordset
Dim rstBooks As DAO.Recordset
Dim rstAuthors As DAO.Recordset
Dim rstBALink As DAO.Recordset
You can put them all on one line separated by commas, but you still need to declare the type for each or Access will assume it's a variant.
Secondly, recordset objects need to be created using the Set keyword, not by using an = alone.
This was done correctly in the top portion of your code, but is incorrect here:
rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
Should be:
Set rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
Set rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
Set rstBALink = dbBooks.OpenRecordset("Authors",dbOpenDynaset)
I think that will solve your issues, but I didn't review every line of your code admittedly. Let me know if you still have problems.
EDIT:
Found a typo:
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
Should be:
Set rstBALink = dbBooks.OpenRecordset("Authors",dbOpenDynaset)
(missed an 'o' in dbBooks)
I am attempting to round-robin names into a "TASK" column depending on which type of job is assigned in the "JOB" column. My table looks like this for example:
my code is as follows:
Sub macro2()
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("table1")
Dim employee(2) As String
employee(0) = "empname1"
employee(1) = "empname2"
Dim i As Integer
With Rst
i = 0
Rst.MoveFirst
Do While Not .EOF
If Rst.Fields("JOB") = "LETTER" Then
Rst.Edit
Rst.Fields("Task").value = employee(i)
Rst.Update
End If
.MoveNext
i = i + 1
If i > 2 Then i = 0
Loop
End With
DoCmd.Requery
End Sub
The problem is, sometimes it "misses" an assignment, and I am not sure why.
It should have kept looping those 2 names into the column, but it wont. However, sometimes after running it a couple of times it will do it. Upon opening the DB fresh, it will not, and will appear as above after completing. Any ideas?
This piece of the code allows i to have a value of 2.
i = i + 1
If i > 2 Then i = 0
But UBound(employee) is 1, which means employee(i) should throw a "subscript out of range" error when i is 2. But you didn't report getting that error, so I don't understand what's going on.
Also your first screenshot shows "Letter" and "Change" in the Job column, but the second screenshot shows all as "Letter". That's another puzzler.
Maybe you need to load the recordset with a query rather than the full table.
Set Rst = CurrentDb.OpenRecordset("SELECT Job, Task FROM table1 " & _
"WHERE Job = 'Letter'")
Then as you move through the recordset rows, toggle i between 0 and 1.
i = IIf(i = 1, 0, 1)
It looks to me like those changes might allow your code to work as you intend. However consider an approach which is more flexible and easier to maintain. Store the employee names in a table and open a second recordset, rsEmployees, to hold those employee names. As you move through the first recordset, Rst, also advance the second: rsEmployees.MoveNext If you reach rsEmployees.EOF, do rsEmployees.MoveFirst That should "round robin" the assignments.
That approach would allow you to add/remove employees from the available pool by simply updating the employees table. You wouldn't need to revise your VBA code each time you add/remove employees.
I have a form with a subform. This subform displays the results of a query that is created dynamically (user enters criteria, I build the SQL, then update the querydef and display). Problem is since the columns are dynamic the width of the columns isn't working out, some are cutting off text.
Is there a way to programmatically loop through the columns (or do the same without loop) and set them all to bestfit width after the query is refreshed?
EDIT: Here is what my code looks like now:
CurrentDb.QueryDefs("SearchResults").sql = sql
CurrentDb.QueryDefs.Refresh
Dim qdf1 As DAO.QueryDef
Dim fld1 As DAO.Field
Set qdf1 = CurrentDb.QueryDefs("SearchResults")
For i = 0 To qdf1.Fields.Count - 1
Set fld1 = qdf1.Fields(i)
fld1.CreateProperty "ColumnWidth", dbInteger
fld1.Properties("ColumnWidth") = -2 'Throws error
Set fld1 = Nothing
Next i
Me.Child20.SourceObject = "Query.SearchResults"
You can set column widths like so:
Sub SetColumnWidth()
Dim qdf1 As DAO.QueryDef
Dim fld1 As DAO.Field
Set qdf1 = CurrentDb.QueryDefs("query3")
For i = 0 To qdf1.Fields.Count - 1
Set fld1 = qdf1.Fields(i)
fld1.CreateProperty "ColumnWidth", dbInteger
'very narrow indeed
'fld1.Properties("ColumnWidth") = 200
'Or -2 : Sizes the column to fit the visible text
'but it is not quite as useful as it would seem
fld1.Properties("ColumnWidth") = -2
Set fld1 = Nothing
Next i
End Sub
See also http://support.microsoft.com/kb/210427
So I've run into this same problem just now. I was fortunate enough to have half of my queries work and the other half not. I've been using this code:
Sub QueryData(strSQL As String)
Dim qryData As DAO.QueryDef
Dim intcount As Integer
Set qryData = CurrentDb.QueryDefs("DataQuery")
qryData.SQL = strSQL
qryData.CreateProperty "ColumnWidth", dbInteger
qryData.Fields(0).Properties("ColumnWidth") = 5760
DoCmd.OpenQuery "DataQuery", , acReadOnly
End Sub
Which generated the error on half of the queries I tried to run with it. I traced it back to this odd, but simple truth: Columns built using an Alias (i.e. all formula columns and expressions) kick out this error. If the column is just a straight data pull, it works fine. If the column is, however, a formulated display.... it spits the no columwidth property error.
Hopefully this'll help someone out! I know this questions about a year old, but it was the first result Google found for me on the topic.
I was able to make this grab the open forms and autofit the selected subform within that form. If you have multiple forms/subforms you would just call the function with the new names using the lines of code at the end of the function and pasting them in your program.
Public Function AutoSizeSbCtrl(frmNameTar, sbCtrlNameTar)
For Each frm In Forms
frmName = frm.Name
If frmName = frmNameTar Then
For Each frmCtrl In frm.Controls
frmCtrlName = frmCtrl.Name
If frmCtrlName = sbCtrlNameTar Then
For Each sbfrmCtrl In frmCtrl.Controls
sbfrmCtrlName = sbfrmCtrl.Name
On Error Resume Next
sbfrmCtrl.ColumnWidth = -2
On Error GoTo 0
Next sbfrmCtrl
End If
Next frmCtrl
End If
Next frm
' paste the lines below in your code where you want it to trigger (i did on an update)
'frmNameTar= "frm12345" ' where frm12345 is the name of the form the subform is in
'sbCtrlNameTar="sbfrm67890" ' where sbfrm67890 is the name of the subform you are trying to autofit
'auSize = AutoSizeSbCtrl(frmNameTar, sbCtrlNameTar)
'end paste
End Function
I'm trying to figure out if there is a way to take a code that I have for merging to a document and set up an if...then that will merge to a different document based on a specific text in a field in a table.
My code that works.
Sub SendConfirmation_Click(CourseNumber As Index)
DoCmd.SetWarnings False
DoCmd.OpenQuery "ConfirmationMailMerge"
Dim LevelIConf As String
Dim OpenWord As Object
'Path to word document
LevelIConf = "G:\POSTPROFESSIONAL\NAIOMT\Classes\PTH536 Level I\LevelIConf.doc"
'Create instance of Word
Set OpenWord = CreateObject("Word.Application")
OpenWord.Visible = True
'Open the document
OpenWord.Documents.Open FileName:=LevelIConf
DoCmd.SetWarnings True
End Sub
I have several Courses that I send out confirmation letters for and each letter is different based on the course. I would like to be able to push a button on the form and have correct document come up based on the course number.
Any help is appreciated. I am a self taught coder and still have lots to learn.
Thanks,
Please note I provide generic solution that may need to be adapted depending on your actual requirements/setup.
Option 1: Your approach (using Word's mail-merge)
You need the following setup:
Two related tables:
Query that returns path to the Conf Letter based on Course ID:
Function that calls the query from previous step:
Function GetConfLetterPathByCourseID(CourseID As Integer) As String
GetConfLetterPathByCourseID = ""
Dim qdf As QueryDef
Dim rs As Recordset
Set qdf = CurrentDb.QueryDefs("GetConfLetterPathByCourseId")
qdf.Parameters("CourseID_par") = CourseID
Set rs = qdf.OpenRecordset
If rs.RecordCount > 0 Then
GetConfLetterPathByCourseID = rs("ConfLetterPath")
End If
End Function
Form with the Send button. Something like this:
And, finally, the Sub for the Send Button:
Sub ConfLetterButton_Click()
DoCmd.SetWarnings False
Dim LevelIConf As String
Dim OpenWord As Object
'Path to word document
LevelIConf = GetConfLetterPathByCourseID(Me.CourseID)
'Create instance of Word
Set OpenWord = CreateObject("Word.Application")
OpenWord.Visible = True
'Open the document
OpenWord.Documents.Open FileName:=LevelIConf
DoCmd.SetWarnings True
End Sub
Please note, I altered slightly your code (e.g. removed Index type, removed Docmd.OpenQuery)
Option 2: Compose email in VBA code and attach the Conf Letter doc file using the Query/Function from option 1. I think this link from Microsoft can provide some details. I did implement similar solution in the past. Worked pretty well.