Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

Change Query Top Values Property with VBA-2

Through last week’s introduction we have seen various ways the Top Value and other properties change the SQL string of a SELECT Query.  Now we will learn how to redefine the Query for the Top Values and other property changes. 

As I have mentioned earlier three type of Queries; SELECT, APPEND and MAKE-TABLE only have the Top Values property.  SELECT and MAKE-TABLE queries have almost identical SQL string with DISTINCT, TOP nn, PERCENT clauses appearing immediately after the SELECT clause at the beginning of the SQL string. 

A sample SQL string of a make-table query is given below:

SELECT TOP 15 PERCENT SalesReportQ.* INTO chart
FROM SalesReportQ
ORDER BY SalesReportQ.Total DESC;

Unlike SELECT and MAKE-TABLE Queries APPEND Queries have the Top Values property settings inserted somewhere in the middle of the SQL string immediately after the SELECT clause. Check the sample SQL of Append Query given below:

INSERT INTO Table3 ( xID, Field1, Field2 )
SELECT DISTINCT TOP 17 PERCENT Table2.ID, Table2.Field1, Table2.Field2
FROM Table2
ORDER BY Table2.ID DESC;

Our VBA program scans through the SQL String to find the TOP Values property Clauses in the SQL String(wherever they appear), removes the existing settings and insert changes as per input from the User.

First we will create a form for the User to input Query Top Values property values and click a Command Button to redefine the SQL.

Image of a sample form is given below:

Two text boxes with the name Qry and TopVal, for Query name and for Top values parameters respectively and a checkbox with the name Unik for Unique value selection.  The Top Values text box can be set with a number or a number with a percentage symbol (like 20 or 15%).  If the Unik checkbox is set then the query suppresses duplicate records based on the selected field values in the Query.

After setting the Query property values in the above controls the user should click the Command Button to redefine the SQl of the selected query in the Query Name control.  The Command Button's name is cmdRun (with the Caption: Modify Query). When the Command Button is clicked the cmdRun_Click() Event Procedure is run (the VBA Code is given below) and validates the input values in the controls above and calls the QryTopVal() function (with parameters: query name, Top Values property value and Checkbox value) to redefine the Query based on the user inputs.

Private Sub cmdRun_Click()
Dim strQuery, strTopVal, bool As Boolean
Dim msg As String

On Error GoTo cmdRun_Click_Err

msg = ""
strQuery = Nz(Me![Qry], "")
If Len(strQuery) = 0 Then
   msg = "  *>>  Query Name not found." & vbCr
End If
strTopVal = Nz(Me![TopVal], 0)
If strTopVal = 0 Then
   msg = msg & "  *>>  Top Property Value not given."
End If
bool = Nz(Me![Unik], 0)
If Len(msg) > 0 Then
    msg = "Invalid Parameter Values:" & vbCr & vbCr & msg
    msg = msg & vbCr & vbCr & "Query not changed, Program Aborted...."
    MsgBox msg, , "cmdRun_Click()"
Else
    'Call the QryTopVal() Function to redefine the Query
    QryTopVal strQuery, strTopVal, bool
End If

cmdRun_Click_Exit:
Exit Sub

cmdRun_Click_Err:
MsgBox Err.Description, , "cmdRun_Click()"
Resume cmdRun_Click_Exit
End Sub

Copy and paste the above VBA Code into the Form Module and save the Form. Don't forget to name the Command Button as cmdRun.

The main function QryTopVal() checks the Query Type (SELECT or APPEND or MAKE-TABLE) and if found valid then reads the SQL of the query.  Checks for the existence of Top Values and other Property settings and if they exists then removes them.  Redefines the query based on the Top Values and other property inputs from the user.

Copy and paste the following VBA Code of QryTopVal() into the Standard Module and save it:

Public Function QryTopVal(ByVal strQryName As String, _
                       ByVal TopValORPercent As String, _
                       Optional ByVal bulUnique As Boolean = False)
'--------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : Jun 2011
'Remarks: All Rights Reserved by www.msaccesstips.com
'Valid Query Types:
'  0 - SELECT
' 64 - APPEND
' 80 - MAKE TABLE
'--------------------------------------------------------------------
Dim strSQL1 As String, strSQL2 As String, strTopValue
Dim db As Database, qrydef As QueryDef, sql As String
Dim loc, qryType As Integer, locTop
Dim txt(1 To 3) As String, num
Dim J, xt, msg As String

On Error GoTo QryTopVal_Err

txt(1) = "DISTINCT"
txt(2) = "TOP"
txt(3) = "PERCENT"

Set db = CurrentDb
Set qrydef = db.QueryDefs(strQryName)
qryType = qrydef.Type

If qryType = 0 Or qryType = 64 Or qryType = 80 Then
   xt = qrydef.sql

   GoSub ParseSQL

   loc = InStr(1, TopValORPercent, "%")

   If loc > 0 Then
      TopValORPercent = Left(TopValORPercent, Len(TopValORPercent) - 1)
   End If

   If Val(TopValORPercent) = 0 Then
      sql = strSQL1 & strSQL2
   Else
      sql = strSQL1 & IIf(bulUnique, "DISTINCT ", "") & "TOP " & TopValORPercent & IIf(loc > 0, " PERCENT ", "") & strSQL2
   End If

   qrydef.sql = sql
   msg = "Query Definition of " & strQryName & vbCr & vbCr & "Changed successfully."
   MsgBox msg, , "QryTop()"
Else
   msg = strQryName & " - Invalid Query Type" & vbCr & vbCr
   msg = msg & "Valid Query Types: SELECT, APPEND and MAKE-TABLE"
   MsgBox msg, , "QryTop"
End If

QryTopVal_Exit:
Exit Function

ParseSQL:
For J = 1 To UBound(txt)
  xt = Replace(xt, txt(J), "", 1)
Next
  
  locTop = InStr(1, xt, "SELECT")
  num = Val(Mid(xt, locTop + 7))
  num = " " & Format(num) & " "
  strSQL1 = Left(xt, locTop + 7)
  xt = Right(xt, Len(xt) - (locTop + 7))
  xt = Replace(xt, num, "", 1, 1)
  strSQL2 = " " & xt
  locTop = InStr(1, strSQL2, "ORDER BY")
  If locTop = 0 Then
    MsgBox "ORDER BY Clause not found in Query.  Result may not be correct.", , "QryTopVal()"
  End If
Return

QryTopVal_Err:
MsgBox Err & " : " & Err.Description, , "QryTopVal()"
Resume QryTopVal_Exit

End Function

You may try the Code with sample Queries.

Share:

Change Query Top Values Property with VBA

We have learned how to use the Top Values Property of Queries (SELECT, MAKE-TABLE and APPEND Queries where this property is applicable) in an earlier Post.  Before going through this Article I suggest you take a look at the earlier one.  To do that click here.

The Top Values Property value of the Query can be set only manually during design time .  You cannot address the Top Values Property of the Query in VBA, to change its present value dynamically.  You cannot ask the User to open the Query in design view and change the value every time when they want a different set of output.  Then what do we do to work with these values?

When we change the Top Values property value manually MS-Access modifies the SQL of the Query to reflect that change.  Keeping this behavior of the Query in mind we can play some tricks with VBA to manipulate the Query's SQL to get what we want, rather than looking for the Property to set the value.  But, before doing that let us examine and find out what happens to the SQL definition of the Query, when you set Top Values and other Properties.

Here is a sample SQL of a SELECT Query with the Top Values Property set with the Value 25.

SELECT TOP 25 Orders.OrderID, Orders.EmployeeID, Orders.OrderDate, Orders.RequiredDate, Orders.Freight
FROM Orders
ORDER BY Orders.Freight DESC;

As you can see in the above example; immediately after the SELECT clause the text TOP 25 is inserted in the SQL string indicating that the TOP Value Property of the Query is set with the value 25.  In the ORDER BY Clause you can see that the Freight Column is sorted in Descending Order.  The result set of the Query is 25 records with the highest Freight Values in the Table.

When you want 25% of the Total records as output from the Orders Table then the Top Values property value must be set as 25%, rather than 25.  The SQL text changes to SELECT TOP 25 PERCENT . . . Sample SQL is given below:

SELECT TOP 25 PERCENT Orders.OrderID, Orders.EmployeeID, Orders.OrderDate, Orders.RequiredDate, Orders.Freight
FROM Orders
ORDER BY Orders.Freight DESC;

The next one that affects the record set is Unique Values Property (valid values are Yes or No).  When it is set; suppresses duplicate records from the output displayed in the Datasheet. But, other field values which are not placed on the Query Column from the Table are not considered while excluding duplicate records.  The DISTINCT Clause is inserted in the SQL immediately after the SELECT Clause.  The modified sample SQL is given below after the Unique Value Property set to Yes.

SELECT DISTINCT TOP 25 PERCENT Orders.OrderID, Orders.EmployeeID, Orders.OrderDate, Orders.RequiredDate, Orders.Freight
FROM Orders
ORDER BY Orders.Freight DESC;

There is one more Query Property Unique Records that can be set (valid values are Yes or No) to suppress duplicate records from output.  When this is set with the value Yes it suppresses duplicate records, based on values in all the fields in the source Table, irrespective of their placement on the Query column.  In this case the DISTINCT clause will be modified as DISTINCTROW in the SQL string.

SELECT DISTINCTROW TOP 25 PERCENT Orders.OrderID, Orders.EmployeeID, Orders.OrderDate, Orders.RequiredDate, Orders.Freight FROM Orders ORDER BY Orders.Freight DESC;

This property we will exclude from our VBA based solution. As you can see from the above examples that depending on the Users' requirement we can add or remove any of these three set of values (DISTINCT, TOP nn & PERCENT) to control the output for Reports.

Our methodology to modify the SQL is very simple to implement. Collect the Query Property values from the User through a Text Box and a Checkbox on a Form. Let the User click a Command Button to redefine the Query.

This will invoke the following actions to redefine the Query:

  1. Open the Query Definition and read the existing SQL String.
  2. Scan the SQL string and look for the text DISTINCT, TOP nn and PERCENT.  If found then remove them from the SQL String.
  3. Validate the input given by the User in the Textbox and checkbox and insert appropriate SQL Clauses in the SQL String.
  4. Update the modified SQL in the Query definition.

This article has become too long now.  Explaining the above four steps and introduction of the VBA Routines may make it even longer.  We will complete this topic in the next blog post.


Share:

Creating Animated Command Button with VBA

The first Blog post that I have written about is Command Button Animation method in September 2006 on this Website.  I used this animation method in almost all my Projects.  The command buttons responding to the mouse moves over them presented a sense of life to the Forms, otherwise remained rigid and boring.  The Command Button and  a Rectangle control set with shadow special effect designed manually.  The Mousemove event procedures on the form are written manually to call a Function to do the job of animation.  I suggest you go through the earlier blog post to get a general idea before continuing.  To go to the earlier Article click here.

Now, we will see how to create the Animated Command Button with its animation programs (for each button) on the Form Module, during Form design time with the click of a button.

With two VBA routines we can do this very easily.

  1. Open one of your databases.
  2. Display the Standard VBA Module.
  3. Create a new Standard Module (Insert - - > Module).
  4. Copy both the following Functions into the Standard Module and save the code:

Command Button Animation Code:

Public Function BAnimate(ByVal strForm As String, ByVal mode As Integer, ByVal lblName As String)
'---------------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : July 1998
'Remarks: Animates the Command Button
'Rights : All Rights Reserved by www.msaccesstips.com
'---------------------------------------------------------------------------
Dim Frm As Form, l As Long, t As Long

On Error GoTo BAnimate_Err

Set Frm = Forms(strForm)

l = Frm.Controls(lblName & "Box").Left
t = Frm.Controls(lblName & "Box").Top

If (mode = 1) And (Frm.Controls(lblName & "Box").Visible = False) Then
    Frm.Controls(lblName & "Box").Visible = True
        Frm.Controls(lblName).Left = l - (0.0208 * 1440)
        Frm.Controls(lblName).Top = t - (0.0208 * 1440)
        Frm.Controls(lblName).FontWeight = 700
ElseIf (mode = 0) And (Frm.Controls(lblName & "Box").Visible = True) Then
    Frm.Controls(lblName & "Box").Visible = False
        Frm.Controls(lblName).Left = l
        Frm.Controls(lblName).Top = t
        Frm.Controls(lblName).FontWeight = 400
End If

BAnimate_Exit:
Exit Function

BAnimate_Err:
Err.Clear
Resume BAnimate_Exit

End Function

Animated Command Button Creation Code:

Public Function CreateButton(ByVal intSection As Integer, strName As String)
'---------------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : Aug. 2000
'Remarks: Creates animated command button controls and Programs on a Form
'       : at design time of the form.
'Rights : All Rights Reserved by www.msaccesstips.com
'---------------------------------------------------------------------------
'Program Parameter Values : intSection
'     0 =  Form Detail Section
'     1 =  Form Header Section
'     2 =  Form Footer Section
'                         : strName
'Command Button Name Property Value
'The Name will be prefixed with the text 'cmd'
'Example: Edit will be modified as cmdEdit
'Sample Run : CreateButton 0,"Edit"
'Remarks    : If more than one Form is opened in Design View then the
'           : Command Button will be created on the first Form
'---------------------------------------------------------------------------
Dim Frm As Form, Ctrl As Control, txt As String
Dim vLeft As Long, vTop As Long, vWidth As Long, vHeight As Long
Dim i As Long, dif As Double, x As Long, Y As Long, z
Dim frmViewStatus As Integer, frmsCount As Integer, j As Integer
Dim hfd As String
On Error Resume Next

i = 1440
dif = 0.0208 * i
vLeft = 0.25 * i
vTop = 0.0521 * i
vWidth = 1.25 * i
vHeight = 0.2375 * i

frmsCount = Forms.Count - 1
frmViewStatus = False
For j = 0 To frmsCount
    If Forms(j).CurrentView = 0 Then
      Set Frm = Forms(j)
      frmViewStatus = True
      Exit For
    End If
Next
If frmViewStatus = False Then
   MsgBox "Open a Form in Design View then try again." & vbCr & vbCr & "Program CreateButton() Aborted."
   Exit Function
End If

  Set Ctrl = CreateControl(Frm.Name, acRectangle, intSection, , , vLeft, vTop, (vWidth - dif), (vHeight - dif))
  
  With Ctrl
    .Name = "cmd" & strName & "Box"
    .SpecialEffect = 4
    .BorderWidth = 3
  End With

  Set Ctrl = CreateControl(Frm.Name, acCommandButton, intSection, , strName, vLeft, vTop, vWidth, vHeight)
  
  With Ctrl
    .Name = "cmd" & strName
    .Caption = strName
  End With
   
  x = Frm.Module.CreateEventProc("MouseMove", Ctrl.Name)
  
  txt = "BAnimate me.name, 1, " & Chr(34) & "cmd" & strName & Chr(34)
  Frm.Module.InsertLines x + 1, txt

  hfd = Choose(intSection + 1, "Detail", "FormHeader", "FormFooter")

  z = Frm.Module.ProcBodyLine(hfd & "_MouseMove", vbext_pk_Proc)

  If z = 0 Then
      x = Frm.Module.CreateEventProc("MouseMove", hfd)
  Else
      x = z + 1
  End If

  txt = "BAnimate me.name, 0, " & Chr(34) & "cmd" & strName & Chr(34)
  Frm.Module.InsertLines x + 1, txt


CreateButton_Exit:
Exit Function

CreateButton_Err:
Resume CreateButton_Exit
End Function

Press Ctrl+S to save the programs. Keep the VBA Window open.

Now that you have the main functions for creating and animating Command Buttons, let us do a quick run to see how easy it is.

  1. Close all open forms, if any.
  2. Open a new Form in Design View.
  3. Display the VBA window, if it was closed or minimized (Alt+F11).
  4. Display the Debug Window (Immediate Window) - Ctrl+G.
  5. Type the following statement in the Debug Window and press Enter Key:
CreateButton 0,"Edit"
  • The first parameter 0 represents the Form's Detail Section (0=Detail, 1=Form Header, 2=Form Footer), where we want the Command Button to appear.
  • Second parameter “Edit” is the Command Button's Name (will be modified as cmdEdit and set in the Name property) and Caption value. Second parameter must be always a single word. This is absolutely necessary to create the MouseMove Event Procedure correctly on the Form's Module. The Caption of the Command Button can be changed later, if necessary.
  1. Minimize the VBA window to show the Form in Design View.  You can see the Command Button is created in the Detail Section of the Form with the Caption Edit.
  2. Change the Form into Form View.
  3. Move the Mouse over the Command Button.  The button moves up a little and to the left to show a shadow at the bottom and to the right of the Command Button.
  4. Move the Mouse out of the button.  The Command Button settles back to the original position hiding the shadow.
  5. Repeat this action in quick succession.  You can see the movement of the button more clearly.

    If you display the Form's VBA Module you can see that the following VBA Program lines are written into it:

    Private Sub cmdEdit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
         BAnimate Me.Name, 1, "cmdEdit"
    
    End Sub
    
    Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        BAnimate Me.Name, 0, "cmdEdit"
    
    End Sub
  6. Change the Form into Design View again.
  7. Click on the Command Button to select it.
  8. Drag the Command Button to the right and down to show the Rectangle Control with the special effect shadow underneath it.

    The Command Button and the Rectangle Control together makes the animation trick.  Click somewhere near the Command Button and drag the Mouse over it to select them together and drag them to the intended location. Do this before you attempt to  create another Command Button in the same section of the Form otherwise the next one will be created and placed over the earlier one.  New Command Buttons are always created on the same location of the form section.

  9. Right-Click on the Detail Section of the Form and select Form Header/Footer to display them on the Form.

Now, you may try the CreateButton() Function with first parameter value 1 or 2 to create Command Buttons in the Form Header or Form Footer Sections respectively.  The Second parameter, Name of the Command Button must be different for all Command Buttons on the same Form.  Sample statements for creating Animated Command Buttons on the Header and Footer of the Form are given below:

CreateButton 1, "PrintPreview"

CreateButton 2, "Exit"

NB: Keep the Header/Footer Sections visible before you attempt to create Command Buttons on them.  There should not be more than one form in Design View.  Otherwise the first form found in design mode will be selected for creating the button controls.

During design time of the form running the CreateButton() Function from the Debug Window is the most convenient method.  But, if you look for something different like launching the program from a Command Button Click then we can do that too. 

We can create a Command Button on a Form to click and input parameter values for the button creation program and quickly create it on the Form currently in Design View and build its Sub-Routines on the Form Module as well.

  1. Open a new Form in Design View.
  2. Create a Command Button as you do normally.
  3. Display its Property Sheet when the Command Button is in selected state (F4).
  4. Change the Name property value to cmdCreate and set the Caption property value to Create Button.
  5. Display the Form's VBA Module (Alt+F11).
  6. Copy and Paste the following Code into the Module and press Ctrl+S to save the Form with the name frmCreateButton:
    Private Sub cmdCreate_Click()
    Dim intSection As Integer, strButtonName As String
    Dim msg As String
    msg = "Form Section (0,1 or 2)" & vbCr
    msg = msg & "0 - Form Details" & vbCr
    msg = msg & "1 - Form Header" & vbCr
    msg = msg & "2 - Form Footer"
    
    intSection = 3
    Do While intSection < 0 Or intSection > 2
        intSection = Nz(InputBox(msg, "cmdCreate_Click()"), 0)
    Loop
    
    strButtonName = ""
    Do While Len(strButtonName) = 0
        strButtonName = InputBox("Command Button Name", "cmdCreate_Click()")
    Loop
    
       If (intSection >= 0 And intSection < 3) And Len(strButtonName) > 0 Then
           CreateButton intSection, strButtonName
       End If
    
    End Sub
  7. Open a Form in Design View and display the Form’s Header/Footer Sections.
  8. Open the frmCreateButton in Normal View.
  9. Click on the Command Button to enter the parameter values for the program.
  10. Input one of the values (0, 1 or 2) suggested by the Prompt to select a Section of the Form and press Enter Key or Click OK button.
  11. Enter a Name for the Command Button in the second prompt (it should be a single word like PrintPreview) and press Enter Key or Click OK.
  12. The Command Button controls are created on the selected Section of the form you kept open in design view.

If you want to use this method on all your Projects then you may transfer the first two Functions (BAnimate() and CreateButton()) Codes into a common Library Database and attach it as Reference Library File (refer the Blog Post Command Button Animation to know how to do this) to your Projects.

Share:

Translate



PageRank
Your email address:

Delivered by FeedBurner

Search

Infolinks Text Ads


Blogs Directory

Popular Posts

Search This Blog

Blog Archive

Powered by Blogger.

Labels

Forms How Tos Functions MS-Access Security Reports msaccess forms Animations msaccess animation Utilities msaccess controls Access and Internet MS-Access Scurity MS-Access and Internet Queries External Links msaccess reports msaccess tips Menus and Toolbars Accesstips MsaccessLinks Process Controls Art Work Downloads msaccess How Tos Graph Charts msaccessQuery List Boxes Command Buttons Emails and Alerts Query Combo Boxes Custom Wizards DOS Commands ms-access functions msaccess functions msaccess graphs msaccess reporttricks msaccessprocess security advanced Access Security Array Custom Functions Data Macros Menus Property Report Top Values VBA msaccess email msaccess menus progressmeter Access2007 Auto-Number Command Button Copy Form Join Microsoft Numbering System Records Security Split SubForm Table Utility Variables Workgroup database msaccess wizards Access2003 Accounting Year Action Animation Attachment Binary Numbers Bookmarks Budgeting Calculation ChDir Color Palette Conditional Formatting Controls Data Filtering Data Type Defining Pages Diagram Disk Dynamic Lookup Error Handler Excel Export Expression External Field Type Fields Filter Form Instances Formatting Groups Hexadecimal Numbers Import Labels List Logo Macro Mail Merge Main Form Memo Methods Monitoring Object Reference Objects Octal Numbers Operating System Paste Primary-Key Product Rank Reading Recordset Rich Text Sequence SetFocus Summary Tab-Page Tables Time Difference Union Query User Users Water-Mark Word automatically commands function hyperlinks iSeries Date iif ms-access msaccess msaccess alerts pdf files reference restore switch text toolbar tutorial updating upload vba code

Featured Post

Function Parameter Array Passing

Last week we have explored the usage of ByVal (By Value) and ByRef (By Reference),  in the Function Parameter, to pass the value from  a Va...

Labels

Blog Archive

Recent Posts