On MS-Access 2003 i've a mask that shows results of a query. For example result of query is:
Column1Column2
1 Y
2 N
3 N
4 Y
It shows in the mask ad a table.
I need to color background field of column2 if the value is Y. To do that i've use the code:
Private Sub Form_Current()
if (Column2) = "Y" Then
Stato.BackColor = vbGreen
End If
End Sub
But it colored all background. So i've tried a workaround:
For Each ctl In Me.Section(acDetail).Controls
If (ctl) = Column2 Then
If (Me.Column2) = "Y" Then
ctl.BackColor = QBColor(2)
End If
End If
But this also colored all bg. Some suggestion?
You can add conditional formatting in code using something like this. This function is based on some code I've used and you may need to tweek it to fit your specific requirements.
Dim fcd As FormatCondition
Dim ctl As control
Dim frm As Form
Dim txt As TextBox
Dim strCond As String
For Each ctl In frm.Controls
If TypeOf ctl Is Access.TextBox Then
If ctl.Visible = True Then
Set txt = ctl
If txt.Name = "Column2" Then
strCond = "=Y"
Set fcd = txt.FormatConditions.Add(acExpression, acEqual, strCond)
fcd.BackColor = QBColor(2)
End If
End If
End If
Next
Related
I am writing up a simple multi-condition search form.
The Access VBA function set for the first toggle button looks like this:
Private Sub ToggleQ1_Click()
Select Case ToggleQ1.Value
Case True
CondQ1 = "AND"
ToggleQ1.Caption = CondQ1
Case False
CondQ1 = "OR"
ToggleQ1.Caption = CondQ1
End Select
End Sub
ToggleQ1 = button's name
CondQ1 = variable to be used with a string to create conditional search.
It would likely be absurd to create 50 more of the same button code, differ only in its name (ex. "ToggleQ50" and "CondQ50")
Is there any way to make it modular and reusable?
Thank you very much in advance.
In the form's module create a function (not sub) like this:
Private Function SetCaption()
Dim clickedButton As Control
Dim CondQ1 As String
Set clickedButton = Me.ActiveControl
Select Case clickedButton.Value
Case True
CondQ1 = "AND"
clickedButton.Caption = CondQ1
Case False
CondQ1 = "OR"
clickedButton.Caption = CondQ1
End Select
End Function
In form designer select all 50 buttons and type in property On Click
=SetCaption()
So, you won't need to create event handler for each button.
Create another sub and send the clicked button to it. Similar to this:
Private Sub cmdTest01_Click()
SetCaption cmdTest01
End Sub
Private Sub cmdTest02_Click()
SetCaption cmdTest02
End Sub
Private Sub SetCaption(clickedButton As CommandButton)
Dim CondQ1 As String
Select Case clickedButton.Caption
Case "Test01"
CondQ1 = "AND"
clickedButton.Caption = CondQ1
Case "Test02"
CondQ1 = "OR"
clickedButton.Caption = CondQ1
End Select
End Sub
Case blocks can be simplified to
Case "Test01"
clickedButton.Caption = "AND"
Case "Test02"
clickedButton.Caption = "OR"
Use WithEvents. That takes a little code when loading and unloading the form, but zero code for each button.
A similar example with full code, which you should be able to adapt, can be found here:
Create Windows Phone Colour Palette and Selector using WithEvents
and at GitHub:
VBA.ModernTheme
Code snippet:
Private ControlCollection As Collection
Private Sub Form_Load()
' Load events for all colour value textboxes.
Dim EventProcedure As ClassTextboxSelect
Dim Control As Access.Control
Set ControlCollection = New Collection
For Each Control In Me.Controls
If Control.ControlType = acTextBox Then
Set EventProcedure = New ClassTextboxSelect
EventProcedure.Initialize Control
ControlCollection.Add EventProcedure, Control.Name
End If
Next
Set EventProcedure = Nothing
Set Control = Nothing
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim Index As Integer
' Set colour palette.
For Index = 0 To 20
Me("Box" & CStr(Index + 1)).BackColor = PaletteColor(Index)
Me("Name" & CStr(Index + 1)).Value = LiteralWpThemeColor(PaletteColor(Index))
Me("Css" & CStr(Index + 1)).Value = RGBHex(PaletteColor(Index))
Me("Vba" & CStr(Index + 1)).Value = PaletteColor(Index)
Me("Hex" & CStr(Index + 1)).Value = "&H" & Hex(PaletteColor(Index))
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Unload events for all colour value textboxes.
Dim EventProcedure As ClassTextboxSelect
For Each EventProcedure In ControlCollection
EventProcedure.Terminate
Next
Set EventProcedure = Nothing
Set ControlCollection = Nothing
End Sub
I am trying to write some code to audit changes made via a form. I have a function that works to do this:
Function WriteChanges()
Dim f As Form
Dim c As Control
Dim user As String
Dim db As DAO.Database
Dim cnn As ADODB.Connection
Dim MySet As ADODB.Recordset
Dim tbld As TableDef
Dim recsource As String
Set f = Screen.ActiveForm
Set db = CurrentDb
Set cnn = CurrentProject.Connection
Set MySet = New ADODB.Recordset
recsource = f.RecordSource
Set tbld = db.TableDefs(recsource)
pri_key = fFindPrimaryKeyFields(tbld)
Debug.Print "pri_key: "; pri_key
user = Environ("username")
MySet.Open "Audit", cnn, adOpenDynamic, adLockOptimistic, adCmdTable
For Each c In f.Controls
Select Case c.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup
If c.Value <> c.OldValue Then
With MySet
.AddNew
![EditDate] = Now
![user] = user
![SourceTable] = f.RecordSource
![SourceField] = c.ControlSource
![BeforeValue] = c.OldValue
![AfterValue] = c.Value
.update
End With
End If
End Select
Next c
MySet.Close
Set MySet = Nothing
Set f = Nothing
Set db = Nothing
End Function
I use this function on the before update property of various forms and it populates the Audit table with the details of the changes to values in each of the controls. I need to also get the value from the primary key field to add to the Audit table. I can use the following code to identify the name of the primary key within the form's record source:
Function fFindPrimaryKeyFields(tdf As TableDef) As String
Dim idx As Index
On Error GoTo HandleIt
For Each idx In tdf.Indexes
If idx.Primary Then
fFindPrimaryKeyFields = Replace(idx.Fields, "+", "")
GoTo OutHere
End If
Next idx
OutHere:
Set idx = Nothing
Exit Function
HandleIt:
Select Case Err
Case 0
Resume Next
Case Else
Beep
MsgBox Err & " " & Err.Description, vbCritical + vbOKOnly, "Error"
fFindPrimaryKeyFields = vbNullString
Resume OutHere
End Select
End Function
How can I use this to get the value from the control (text box) that has the identified primary key as its control source.
Please forgive any silly errors in my code as I'm a relative novice. Thanks in advance for any help.
I'm not 100% sure what you want exactly, but if you have the name of the field, you can use the following:
Dim primaryKeyValue As Variant
Dim primaryKeyColumnName As String
primaryKeyColumnName = fFindPrimaryKeyFields(TableDefs!MyTable)
Dim f as Form
'Get the form somehow
Dim c As Control
On Error GoTo NextC 'Escape errors because lots of controls don't have a control source
For Each c In f.Controls
If c.ControlSource = primaryKeyColumnName Then
primaryKeyValue = c.Value
End If
NextC:
Next c
On Error GoTo 0
If the primary key column is part of the form record source, you can simply read it by:
Debug.Print "PK value: " & f(pri_key)
Every column of the record source is a form property at runtime, independent of whether there is a control with the same name.
Note: your whole construct will stop working if you have a form that is based on a query that joins multiple tables.
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.
I'm trying to write a sub that will get two parameters - a textbox in a form and a text.
My intention is that the function will append the text into any textbox.
Sub AppendTextBox([any textbox in my form], text As String)
[code that appends the text parameter to the textbox]
End Sub
Please note that I'm not trying to append text to a specific textbox, but to create a function that can receive any textbox in the form and append it with any text.
Thanks for your help.
I've found the answer and it's much simpler than I though it is:
Private Sub AAA(A)
A.Value = "Desired text"
End Sub
Or if you want to append:
Private Sub AAA(A)
A.Value = A.Value & vbnewline & "Desired text"
End Sub
Hi Zephram have you managed to find the solution for this?
I have one but is a bit heavy because it uses loops. If you have one better let me know.
Private Function change_TextBox2(altera As String, textbox As ctl, valor As Variant)
Dim ctl As Control
If altera = "Popula" Then
For Each ctl In Me.Controls
With ctl
If (InStr(.Name, textbox)) > 0 Then
.Value = valor
End If
End With
Next ctl
ElseIf altera = "hide" Then
For Each ctl In Me.Controls
With ctl
If (InStr(.Name, textbox)) > 0 Then
.Visible = False
End If
End With
Next ctl
End If
End Function
can be accomplished by:
dim appendTxt as String: appendTxt = "appended text"
dim ws as Worksheet: for each ws in ActiveWorkbook.Worksheets
dim shape as Shape: for each shape in ws.Shapes
if shape.Type = msoTextBox then
'you can move this code parameterized to a separate function then as req by OP:
with shape.TextEffect: .Text = .Text & appendTxt
end if
next shape
next ws