The left side message box is the default style of MS-Access and the right-side one is with the use of Office Assistant. The Program uses the default Office Assistant Setting for Message Boxes. Here the Office Cat is the default setting, hence it is appearing with the Message Box. By adding a few Functions in a Global Module of your MS-Access Project will help you to make use this feature wherever you need them. Some of the very commonly used Functions are created separately for ease of use limiting the maximum Number of Parameters needed for the Functions to two and 2^nd Parameter for Title is Optional and can be omitted. First Parameter for Message Text and the second one for Title. Button Type and Icon Type is already added to the Function. The following Functions are available and their usage Syntax is as follows:

MsgOK("Message Text","Title") - MessageBox with only OK Button

MsgYN("Message Text","Title") - MessageBox with Yes & No Buttons. Returned Value is vbYes or vbNo

MsgOKCL("Message Text","Title") - MessageBox with OK, Cancel Buttons. Returned Value is vbOK or vbCancel

First you must attach the Microsoft Office 9.0 Object Library (or whatever version of Office you have) to your Project. You must add other essential Library Files to your Project as well. Please refer my earlier post Title: Command-Button Animation for a List of Project Library Files and procedures to attach them to your Project. After completion of Library Files fixing copy the following Code into a Global Module and save them.

Public Function MsgOK(ByVal strmsg As String, _
Optional ByVal strHeading As String) As Integer

On Error resume next
MsgOK = MsgBalun(strmsg, strHeading, msoButtonSetOK, _
msoAnimationGestureUp, msoIconAlertInfo)
End Function


Public Function MsgOKCL(ByVal strmsg As String, _
Optional ByVal strHeading As String) As Integer

on error resume next
   MsgOKCL = MsgBalun(strmsg, strHeading, msoButtonSetOkCancel, _
   msoAnimationWritingNotingSomething, msoIconAlertQuery)
End Function


Public Function MsgYN(ByVal strmsg As String, _
Optional ByVal strHeading As String) As Integer
on error resume next
   MsgYN = MsgBalun(strmsg, strHeading, msoButtonSetYesNo, _
   msoAnimationWritingNotingSomething, msoIconAlertQuery)
End Function


Private Function MsgBalun(ByVal strText As String, _
ByVal strTitle As String, ByVal lngButtons As Long, _
ByVal intAnimation, ByVal intIcon) As Integer
'------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : September 2006
'------------------------------------------------------------
Dim lngx As Long, intVal As Integer, Balu As Balloon
On Error GoTo MsgBaloons_Err

With Assistant
  If .On = False Then
    .On = True
    '.FileName = "OFFCAT.acs"
    .Animation = msoAnimationGetAttentionMinor
    .AssistWithHelp = True
    .GuessHelp = True
    .FeatureTips = False
    .Visible = True
  End If
End With

Set Balu = Assistant.NewBalloon
With Balu
    .Animation = intAnimation
    .Icon = intIcon
   .Heading = strTitle
   .Text = strText
   .BalloonType = msoBalloonTypeButtons
   .Button = lngButtons

Select Case Balu.Show
       Case msoBalloonButtonOK
           MsgBalun = vbOK
       Case msoBalloonButtonCancel
          MsgBalun = vbCancel
       Case msoBalloonButtonYes
          MsgBalun = vbYes
       Case msoBalloonButtonNo
          MsgBalun = vbNo
End Select
End With

Assistant.Visible = False

MsgBaloons_Exit:
Exit Function

MsgBaloons_Err:
MsgBox Err.Description, , "MsgBaloons"
Resume MsgBaloons_Exit
End Function

You can use these Functions without bothering about selecting the Button-Type, IconType etc. that you normally need to give along with the MessageBox Command like: vbYesNo+vbDefaultButton2+vbQuestion

Usage Example:

1. If MsgYN("Select Yes to Proceed, No to Cancel.","cmdProcess") = vbYes then

Docmd.runmacro "Process"

End if

OR

If MsgYN("Select Yes to Proceed, No to Cancel.") = vbYes then

Docmd.runmacro "Process"

End if

2. MsgOK "System is preparing to Shut Down","cmdExit_Click"

OR

MsgOK "System is preparing to Shut Down"

The MsgBalun() Function is not directly used in programs.

Implement the procedures in your Project and try them out.

Labels: msaccess animation

This is the continuation of a series of different 3D-Heading-Styles introduced for designing Microsoft Access Form/Report Headings. This design is a variant of the 3D-Heading Style presented under the Title Create 3D Headings on Forms. Both the Styles has its own beauty and once they are created you may copy the same Controls and customize them with different Fore-color, Font & Font Styles (Bold, Italics etc.) and use it on Form or Report Headings.

If you are the first-time visitor on this site and landed straight on this page you must prepare your MS-Access Project by adding few Library Files and Main Programs (if you have not already done) before you are able to run the Code for this Heading Style and others presented on this Site. Follow the steps given below:

1. Link few Common Library Files (they are already there in your System, you only need to attach them) to your Project by following the steps described in my earlier post with the Title Command-Button Animation

2. You need to copy all the VB Codes given under the Title Create 3D Heading on Forms and paste them into a Global Visual Basic Module in your Project and save the Module. This Code implements the Main Functions of each Heading Styles presented so far including this one.

Once you are ready with the above you may copy the Code for this Heading Style and try it out. Copy the Code below into the same Global Module, where you have copied the Main Programs, or any Global Module you prefer and save it.

Public Function Shadow3D(ByVal intStyle As Integer, _
ByVal intForeColor As Integer, _ 
Optional ByVal Label0Text1 As Integer) As String 
'----------------------------------------------------------
'Author : a.p.r. pillai
'Date   : September 2006
'----------------------------------------------------------
Dim intlbls As Integer, intFSize As Integer 
Dim j As Integer, mySection As Section 
Dim lblName() As String, lngForecolor As Long, X As Integer 
Dim l As Long, t As Long 

On Error Resume Next 

Shade3D = FormTxtLabels(Label0Text1) 

Set mySection = MyFrm.Section(acDetail) 
intlbls = mySection.Controls.Count - 1 

On Error GoTo Shadow3D_Err 

X = Validate_Dup(MyFrm, 5) ' check type and duplicate 

If X = 1 Then 
  Exit Function 
End If 
intlbls = mySection.Controls.Count - 1 

X = intStyle 
intStyle = IIf(X < 0, 0, IIf(X > 3, 3, intStyle)) 
X = intForeColor 
intForeColor = IIf(X < 0, 0, IIf(X > 15, 15, intForeColor)) 

ReDim lblName(0 To intlbls) As String 

For j = 0 To intlbls 
 lblName(j) = mySection.Controls(j).NAME 
Next 

For j = 0 To intlbls 
  With mySection.Controls(lblName(j)) 
    .Height = lngheight 
    .Width = lngWidth 
    .FontName = "Times New Roman" 
    intFSize = .FontSize 
    If intFSize < intFontSize Then 
      .FontSize = intFontSize 
    End If 
    .FontUnderline = False 
    .TextAlign = intTextAlign 
    .BackStyle = intBackStyle 
   Select Case j 
     Case 0 
      lngForecolor = 8421504 
     Case 1 To intlbls - 2 
      lngForecolor = 8421504 
     Case intlbls - 1 
      lngForecolor = 0 '12632256 
     Case intlbls 
      lngForecolor = QBColor(intForeColor) 
    End Select 
      .ForeColor = lngForecolor 
 End With 
Next 
l = intX: t = intY 

With mySection.Controls(lblName(1)) 
  .Left = l 
  .Top = t 
End With 
For j = 0 To intlbls 
Select Case intStyle 
       Case 0 
          l = l + LngI 
          t = t + LngI 
       Case 1 
          l = l + LngI 
          t = t - LngI 
       Case 2 
        l = l - LngI 
        t = t + LngI 
       Case 3 
          l = l - LngI 
          t = t - LngI 
End Select 
  With mySection.Controls(lblName(j)) 
     .Left = l 
     .Top = t 
  End With 
Next 
MsgLabel 

Shadow3D_Exit: 
Exit Function 

Shadow3D_Err: 
Msgbox Err.Description,, "Shadow3D" 
Resume Shadow3D_Exit 
End Function 

To create the Shadow3D Heading Style:

a. Press Alt+F11 to Display the Visual Basic Editing Screen (you can toggle between Database and VB Window with this Shortcut)

b. Press Ctrl+G (or View Menu --> Immediate Window) to display the Debug Window

Type the following in the Debug Window and press Enter:

Shadow3D 1, 0

You will see the Screen flashes a little as if it is refreshed. Minimize the Visual Basic Module Window and you will see a new Form has been created with the above Heading Style. Help to customize the Control with your own Font, Font Style or Heading Text is also created in a Label Control, which you may follow to change it into your own style.

Let us examine the Command Line Values.

Shadow3D - is the Function Name

1 - First Parameter to the Function which controls the Shadow position of the Heading Text. Range of Values are from 0 to 3.

0 - Shadow position left top corner

1 - bottom left corner

2 - Right top corner

3 - Right bottom corner

0 - Second parameter 0 will create 3D Text on Label controls. By default the Function creates label based Heading Text and this can be omitted. If omitted, then do not use a coma after the first parameter. If 1 is used then the Function creates TextBox based control with Heading Text placed in a Formula in the Control Source property. You can change the Value in the Formula or change to show values from the underlying field of table/query attached to the Form. Or you can write a Dlookup() Function to pick the Value from a different Table.

Example : =Dlookup("CountryName","CountryTable","CountryCode = ‘USA’")

The above example will show United States of America in 3D Style from the CountryTable based on the Values in CountryCode & CountryName Fields. If The criteria parameter of the Function needs to obtain a Value from the current table attached to the Form then modify the Function to:

=Dlookup("CountryName","CountryTable","CountryCode = ‘“ & [CCode] & "’")

Where [CCode] is the Field Name where the country codes are stored in the Table/Query attached to the Form. Note the single quote immediately after the equal sign followed by a double-quote and the closing single quote within double-quotes before the closing parenthsis indicating the CCode field value is character type data.

Tip: Search in MS-Access Help for more details on Dlookup() Function.

Labels: msaccess tips

If you have landed straight into this Page please refer my earlier Posts: Command-Button Animation to link the essential Library Files (the list of files and explains how to attach them) to your Project and visit Create 3D Headings on Forms to copy and paste the Main Programs

FormTxtLabels()

Validate_Dup()

MsgLabel()

(which are required to Run the Function introduced here) into the Visual Basic Global Module of your Project.

Public Function Border3D(ByVal intStyle As Integer, _ 
ByVal intForeColor As Integer, ByVal intBorderColor As Integer, _ 
Optional ByVal Label0Text1 As Integer) As String 
'--------------------------------------------------
'Author : a.p.r. Pillai
'Date   : September 2006 
'--------------------------------------------------
Dim intlbls As Integer 
Dim j As Integer, ForeColor As Long, BorderColor As Long 
Dim lblName() As String, X As Integer, mySection As Section 
Dim l As Long, t As Long, I As Long, intFSize As Integer

On Error Resume Next 

I = 0.0104 * 1440 ' 0.0104 inches 


Border3D = FormTxtLabels(Label0Text1) 

Set mySection = MyFrm.Section(acDetail) 
intlbls = mySection.Controls.Count - 1 

On Error GoTo Border3D_Err 

X = Validate_Dup(MyFrm, 7) ' check type and duplicate 

If X = 1 Then 
   Exit Function 
End If 
intlbls = mySection.Controls.Count - 1 

X = intForeColor 
intForeColor = IIf(X < 0, 0, IIf(X > 15, 15, intForeColor)) 
X = intBorderColor
intBorderColor = IIf(X < 0, 0, IIf(X > 15, 15, intBorderColor)) 
X = intStyle 
intStyle = IIf(X < 0, 0, IIf(X > 3, 3, intStyle)) 

ReDim lblName(0 To intlbls) As String 

ForeColor = QBColor(intForeColor) 
BorderColor = QBColor(intBorderColor) 

For j = 0 To intlbls 
 lblName(j) = mySection.Controls(j).NAME 
Next 

For j = 0 To intlbls 
  With mySection.Controls(lblName(j)) 
    .Height = lngheight 
    .Width = lngWidth 
    .FontName = "Times New Roman" 
    intFSize = .FontSize 
    If intFSize < intFontSize Then 
      .FontSize = intFontSize 
    End If 
    .FontUnderline = False 
    .TextAlign = intTextAlign 
    .BackStyle = intBackStyle 
  End With 
Next 

mySection.Controls(lblName(intlbls)).ForeColor = ForeColor 
  
For j = 0 To intlbls - 1 
  mySection.Controls(lblName(j)).ForeColor = BorderColor 
Next 

l = intX: t = intY 

With mySection.Controls(lblName(intlbls)) 
  .Left = l 
  .Top = t 
End With 

For j = 2 To intlbls - 1 
  With mySection.Controls(lblName(j)) 
     Select Case j 
        Case 2 
          .Left = l + I 
          .Top = t + I 
        Case 3 
          .Left = l + I 
          .Top = t - I 
        Case 4 
          .Left = l - I 
          .Top = t + I 
        Case 5 
          .Left = l - I 
          .Top = t - I 
     End Select 
  End With 
Next 

  For j = 0 To 1 
   With mySection.Controls(lblName(j)) 
    '.ForeColor = 9868950 
    .ForeColor = 0 
   If j = 0 Then 
    Select Case intStyle 
       Case 0 
           .Left = l - (I * 3) 
           .Top = t - (I * 3) 
       Case 1 
           .Left = l - (I * 3) 
           .Top = t + (I * 3) 
       Case 2 
           .Left = l + (I * 3) 
           .Top = t - (I * 3) 
       Case 3 
           .Left = l + (I * 3) 
           .Top = t + (I * 3) 
    End Select 
  Else 
    Select Case intStyle 
         Case 0 
           .Left = l - (I * 2) 
           .Top = t - (I * 2) 
       Case 1 
           .Left = l - (I * 2) 
           .Top = t + (I * 2) 
       Case 2 
           .Left = l + (I * 2) 
           .Top = t - (I * 2) 
       Case 3 
           .Left = l + (I * 2) 
           .Top = t + (I * 2) 
    End Select 
  End If 
    End With 
Next 
MsgLabel 

Border3D_Exit: 
Exit Function 

Border3D_Err: 
Msgbox Err.Description,, "Border3D" 
Resume Border3D_Exit 
End Function 

To Create the Border3D Heading Text, display the Debug Window (Immediate Window)by pressing Ctrl+G (if you are already in the Visual Basic Module otherwise press Alt+F11 to display that first) then type the following line in the Immediate Window:

Border3D 1,15,0

The Module window will flash for a moment as if it is refreshed. Minimize the VB Module Window and you will see a New Form Created and kept minimized by the Program. Restore the Form and Save it with the Heading Text.

First let us see the Values entered as Parameter to the above Function. The first two Parameters are mandatory when the function is called and if they are not used the program will show Error Message 'Parameter not optional' and the third value is optional.

Parameter Values:

First Value 1 represents the Shadow Style and Value Range is 0 - 3 for the shadow tilted to any one of the four corners of the Text. The Value 1 will place the Shadow at left Bottom Corner of the Text.

The Second Value 15 represents Border Color and the Value Range is from 0 to 15 (15 = White).

Third Value 0 or 1 is optional and if omitted, 0 is assumed and it will create a Label based Heading Text, 1 will create a TextBox based Heading.

After creating the Heading Select all the controls together by clicking outside the controls and dragging the mouse over them. Once all the controls are selected together display the Property Sheet (Press F4 or View Menu--> Property) and change the Caption to your own Text. Change the Font, Font Size, Font Style Bold or Italic. Now click somewhere on the form away from the controls to de-select them then click on the top layer of the Labels and change the ForeColor of the Heading to your choice. Now Select all of them as you did earlier press Ctrl+C to Copy them into clipboard, Open your Form or Report in Design view and Paste the Heading on it. This Form you can save it as a Template so that you can copy, modify and use it on other Forms or Reports without running the Program from the Module window.

Labels: msaccess tips

Public Function Border2D(ByVal intForeColor As Integer, _
ByVal intBorderColor As Integer, _
Optional ByVal Label0Text1 As Integer) As String  
'------------------------------------------------------------  
'Author : a.p.r. pillai  
'Date : September 2006  
'------------------------------------------------------------  
Dim intlbls As Integer  
Dim j As Integer, ForeColor As Long, BorderColor As Long  
Dim lblName() As String, X As Integer, mySection As Section  
Dim l As Long, t As Long, intFSize As Integer

On Error Resume Next  

Border2D = FormTxtLabels(Label0Text1)  

Set mySection = MyFrm.Section(acDetail)  

intlbls = mySection.Controls.Count - 1  

On Error GoTo Border2D_Err  

X = Validate_Dup(MyFrm, 5) ' check type and duplicate  

If X = 1 Then  
Exit Function  
End If  

intlbls = mySection.Controls.Count - 1  

X = intForeColor  
intForeColor = IIf(X < 0, 0, IIf(X > 15, 15, intForeColor))  
X = intBorderColor  
intBorderColor = IIf(X < 0, 0, IIf(X > 15, 15, intBorderColor))  

ReDim lblName(0 To intlbls) As String  

ForeColor = QBColor(intForeColor)  
BorderColor = QBColor(intBorderColor)  

For j = 0 To intlbls  
lblName(j) = mySection.Controls(j).NAME  
Next  

For j = 0 To intlbls  
With mySection.Controls(lblName(j))  
.Height = lngheight  
.Width = lngWidth  
.FontName = "Times New Roman"  
intFSize = .FontSize  
If intFSize < intFontSize Then  
.FontSize = intFontSize  
End If  
.FontUnderline = False  
.TextAlign = intTextAlign  
.BackStyle = intBackStyle  
End With  
Next  

mySection.Controls(lblName(intlbls)).ForeColor = ForeColor  

For j = 0 To intlbls - 1  
mySection.Controls(lblName(j)).ForeColor = BorderColor  
Next  

l = intX: t = intY  

With mySection.Controls(lblName(4))  
.Left = l  
.Top = t  
End With  

For j = 0 To intlbls - 1  
With mySection.Controls(lblName(j))  
If j = 0 Or j = 3 Then .Left = l - LngI  

If j = 1 Or j = 2 Then .Left = l + LngI  

If j = 0 Or j = 1 Then .Top = t  

If j = 1 Then .Top = t - (0.0104 * 1440)  

If j = 0 Then .Top = t + (0.0104 * 1440)  

If j = 2 Then .Top = t + LngI  

If j = 3 Then .Top = t - LngI  

End With  
Next  
MsgLabel  

Border2D_Exit:  
Exit Function  

Border2D_Err:  
MsgBox Err.Description,, "Border2D"  
Resume Border2D_Exit  
End Function 

To Run the Function to create the heading text on a new Form, open the VB Module Window (if not already open) by pressing Alt+F11 then press Ctrl+G to open the Immediate Window (Debug window). Type the following text and press Enter.

Border2D 15,0

The First Parameter is mandatory (Color Value Range 0 – 15) and the 2^nd one (Value 0 or 1) is optional. If the Function is called without the first parameter then the Error:

The first Parameter 15 is for White Border Color and the Second Parameter 0 stands for Label based Heading (if 2^nd Parameter is omitted do not use the coma at the end of first parameter). If 1 is used as 2^nd Parameter then a TextBox based Heading is created and text will be placed as a Formula in the Control Source Property.

The Module Window will flash a little as if it is refreshed. Minimize the Module Window (with Alt+F11 you can toggle the window) to show up the Database Window and you will see a New Form is Created with the name like Form1 and the Border2D heading is created with a White Border. You can use any color number between 0 to 15. Once the Heading is created you can modify it in several ways.

To change the Heading Text, Text Style, Border Color and Text Color:

Select all the controls together and display the Property Sheet and change the Caption with the Text of your choice. You can make the Text Bold, Italic or change the Size of the Text. Select a Color from the Color Pallette for Border first. This will change the Forecolor of all Labels. Now Click only on the top Label and apply a different Color for Foreground.

--oOo--

Labels: msaccess tips

Before proceeding further ensure that you have linked the essential Project Library Files to your Project otherwise you may end up with Error while running the code. Read my earlier post Command-Button Animation and follow the steps described there to Link all the essential Library Files to your Project.

1. Copy and Paste the following code in a new Global Module and save it:

Option Compare Database 
Option Explicit 
'-- Global declarations 
Private Const lngheight as long = 0.45 * 1440 
Private Const lngWidth as long = 4.5 * 1440 
Private Const intFontSize as integer = 26 
Private Const intTextAlign as integer = 0 
Private Const intBackStyle as integer = 0 
Private Const LngI as long = 0.0104 * 1440 
Private Const intX as long = 0.15 * 1440 
Private Const intY as long = 0.15 * 1440 
Dim MyFrm As Form 

Public Function FormTxtLabels( _
Optional ByVal ControlType As Integer) As String 
'--------------------------------------------------- 
'Author : a.p.r. pillai 
'Date : September 2006 
'
'ControlType = 0 for label 
'ControlTYPE = 1 for TextBox 
'--------------------------------------------------- 
Dim ctl As Control 

'On Error GoTo FormTxtLabels_Err 
If ControlType > 0 Then ControlType = 1 


Set MyFrm = CreateForm 

If ControlType = 1 Then 
  Set ctl = CreateControl(MyFrm.NAME, acTextBox, _
  acDetail, , , (0.2 * 1440), (0.2 * 1440), lngWidth, lngheight) 

  With ctl
    .ControlSource = "=" & Chr(34) & _
"msaccesstips.com" & Chr(34) 
  End With 
Else 
  Set ctl = CreateControl(MyFrm.NAME, acLabel, _
acDetail, , , (0.2 * 1440), (0.2 * 1440), lngWidth, lngheight)
 
With ctl 
.Caption = "msaccesstips.com" 
End With 
End If 

FormTxtLabels = MyFrm.NAME 

FormTxtLabels_Exit: 
Exit Function 

FormTxtLabels_Err: 
MsgBox Err.Description, , "FormTxtLabels" 
FormTxtLabels = "" 
Resume FormTxtLabels_Exit 
End Function 


Public Function Validate_Dup(ByRef MyFrm As Form, _
ByVal intNooflabels As Integer) As Integer 

Dim mysec As Section, lblcount As Integer 
Dim myctrl As Control, newctrl As Control, j As Integer 
Dim lngx As Long, lngY As Long, lngH As Long, lngW As Long 
Dim strCap As String, ctrltype As Integer, intlbls As Integer 
Dim ctrlName() As String, ctrlIndex() As Integer, i As Long
Dim strFont As String, intFntSize As Integer, x As Integer 
Dim intFntWeight As Integer  

'On Error GoTo Validate_Dup_Err 

Set mysec = MyFrm.Section(acDetail) 
intlbls = mysec.Controls.Count - 1 

Set myctrl = mysec.Controls(0) 
ctrltype = myctrl.ControlType 
intNooflabels = intNooflabels - 1 
If intlbls > 0 Then 
ReDim ctrlName(intlbls) As String
ReDim ctrlIndex(intlbls) As Integer 
End If 
If ctrltype = 109 And intlbls > 0 Then 
For j = 0 To intlbls 
Set myctrl = mysec.Controls(j) 
ctrlIndex(j) = myctrl.ControlType 
ctrlName(j) = myctrl.NAME 
Next 
For j = 0 To intlbls 
If ctrlIndex(j) = 100 Then 
DeleteControl MyFrm.NAME, ctrlName(j) 
End If 
Next 
intlbls = mysec.Controls.Count - 1 
End If 

Set myctrl = mysec.Controls(0) 
If intlbls < intNooflabels Then 
With myctrl 
lngx = .Left 
lngY = .Top 
lngW = .Width 
lngH = 0.0208 * 1440 ' 0.0208 inches 
strFont = .FontName 
intFntSize = .FontSize 
intFntWeight = .FontWeight 
End With 

If ctrltype = 100 Then 
strCap = myctrl.Caption 
ElseIf ctrltype = 109 Then 
strCap = myctrl.ControlSource 
End If 
If ctrltype = 109 And intlbls > 0 Then 
For j = 0 To intlbls 
Set myctrl = mysec.Controls(j) 
ctrlIndex(j) = myctrl.ControlType 
ctrlName(j) = myctrl.NAME 
Next 
For j = 0 To intlbls 
If ctrlIndex(j) = 100 Then 
DeleteControl MyFrm.NAME, ctrlName(j) 
End If 
Next 
intlbls = mysec.Controls.Count - 1 
Set myctrl = mysec.Controls(intlbls) 
With myctrl 
lngx = .Left 
lngY = .Top 
lngW = .Width 
lngH = .Height 
ctrltype = .ControlType 
strFont = .FontName 
intFntSize = .FontSize 
intFntWeight = .FontWeight 
End With 
End If 

i = 0.0104 * 1440 + lngH ' 0.0104 inches 
lngY = lngY + i 
For j = intlbls + 1 To intNooflabels 

Set newctrl = CreateControl(MyFrm.NAME, ctrltype, _
acDetail, "","", lngx, lngY, lngW, lngH) 

If ctrltype = 100 Then 
newctrl.Caption = strCap 
newctrl.FontName = strFont 
newctrl.FontSize = intFntSize 
newctrl.FontWeight = intFntWeight 
Else 
newctrl.ControlSource = strCap 
newctrl.FontName = strFont 
newctrl.FontSize = intFntSize 
newctrl.FontWeight = intFntWeight 
End If 
lngY = lngY + i 
Next 
End If 

If intlbls > intNooflabels Then 
For j = intNooflabels + 1 To intlbls 
Set myctrl = mysec.Controls(j) 
ctrlIndex(j) = myctrl.ControlType 
ctrlName(j) = myctrl.NAME 
Next 
For j = intNooflabels + 1 To intlbls 
DeleteControl MyFrm.NAME, ctrlName(j) 
Next 
Validate_Dup = 0 
End If 

intlbls = mysec.Controls.Count - 1 
Set myctrl = mysec.Controls(0) 
ctrltype = myctrl.ControlType 
If ctrltype = 109 Then 
For j = 0 To intlbls 
Set myctrl = mysec.Controls(j) 
With myctrl 
.Enabled = False 
.Locked = True 
.SpecialEffect = 0 
End With 
Next 
End If 
Validate_Dup = 0 

Validate_Dup_Exit: 
Exit Function 

Validate_Dup_Err: 
MsgBox Err.Description, ,"Validate_Dup" 
Validate_Dup = 1 
Resume Validate_Dup_Exit 
End Function 


Public Function MsgLabel() 
'------------------------------------------------------------ 
'Author : a.p.r. pillai 
'Date : September 2006 
'------------------------------------------------------------ 
Dim mySection As Section, ctl As Control, xForm As Form 
Dim l As Long, t As Long, w As Long, h As Long, F As Long 
F = 1440 
l = 0.5 * F: t = 1.2 * F: w = 3.6563 * F
h = 0.4896 * F 'values in inches 
On Error Resume Next 
Set mySection = MyFrm.Section(acDetail) 
Set ctl = CreateControl(MyFrm.NAME, acLabel, _
acDetail, , "", l, t, w, h) 
ctl.Caption = "Click outside the Controls and Drag Over. " _ 
& "Display the Property Sheet. " & _
"Type New Text for Caption/Control " _ 
& "Source Property area for Label/ Text Boxes. " & _
"Copy and Paste the Controls to " _ 
& "Target Form/Report Area." 

End Function 



Public Function Heading3D(ByVal intStyle As Integer, _
ByVal intForeColor As Integer, _ 
Optional ByVal Label0Text1 As Integer) As String 

'------------------------------------------------------------ 
'Author : a.p.r. pillai 
'Date : September 2006 
'------------------------------------------------------------ 
Dim intlbls As Integer, mySection As Section 
Dim j As Integer, intFSize As Integer 
Dim lblName() As String, lngForecolor As Long, x As Integer 
Dim l As Long, t As Long 

On Error Resume Next 

Heading3D = FormTxtLabels(Label0Text1) 

Set mySection = MyFrm.Section(acDetail) 
intlbls = mySection.Controls.Count - 1 

On Error GoTo Heading3D_Err 

x = Validate_Dup(MyFrm, 5) 'check type and duplicate 

If x = 1 Then 
Exit Function 
End If 

intlbls = mySection.Controls.Count - 1 

x = intStyle 
intStyle = IIf(x < 0, 0, IIf(x > 3, 3, intStyle)) 

x = intForeColor 
intForeColor = IIf(x < 0, 0, IIf(x > 15, 15, intForeColor)) 

ReDim lblName(0 To intlbls) As String 

For j = 0 To intlbls 
lblName(j) = mySection.Controls(j).NAME 
Next 

For j = 0 To intlbls 
With mySection.Controls(lblName(j)) 
.Height = lngheight 
.Width = lngWidth 
.FontName = "Times New Roman" 
intFSize = .FontSize 
If intFSize < intFontSize Then 
.FontSize = intFontSize 
End If 
.FontUnderline = False 
.TextAlign = intTextAlign 
.BackStyle = intBackStyle 
Select Case j 
Case 0 
lngForecolor = 0  
Case 1 To intlbls - 2 
lngForecolor = 9868950 
Case intlbls - 1 
lngForecolor = 16777215 
Case intlbls 
lngForecolor = QBColor(intForeColor) 
End Select 
.ForeColor = lngForecolor 
End With 
Next 

l = intX: t = intY 
With mySection.Controls(lblName(1)) 
.Left = l 
.Top = t 
End With 

For j = 0 To intlbls 
Select Case intStyle 
Case 0 
l = l + LngI 
t = t + LngI 
Case 1 
l = l + LngI 
t = t - LngI 
Case 3 
l = l - LngI 
t = t - LngI 
Case 2 
l = l - LngI 
t = t + LngI 
End Select 
With mySection.Controls(lblName(j)) 
.Left = l 
.Top = t 
End With 
Next 

MsgLabel 

Heading3D_Exit: 
Exit Function 

Heading3D_Err: 
Msgbox Err.Description, ,"Heading3D" 
Resume Heading3D_Exit 
End Function 

The first 3 Functions in the above code:

FormTxtLabels()

Validate_Dup()

MsgLabel()

are Sub-Routines for the Heading3D() Function (they are not direcctly run) and will be used for other forth-coming Heading Styles too.

To create the 3D-Heading on a new Form, display the Visual Basic Window (if not already open) press Alt+F11. Press Ctrl+G (or select Immediate Window from View Menu) to display the Immediate Window.

Type the next line in the immediate window and press Enter Key:

Heading3D 1, 0

The module window will flash as if it is refreshed. Minimize the Visual Basic window. You will see the program has created a new Form (with name like Form1 etc.) and created a 3D-Heading with default text msaccesstips.com with help-text below it suggesting modifications. Select all the controls together by clicking outside the controls and draging the mouse over them. Copy and paste them in your Form/Report where you need it. Display the property sheet while all the controls are selected together and change the caption property with your own text. Change the font or style like Bold, Italic etc, if needed. Click on the top control carefully (so that the top label is not moved out of place) and change the color of your choice. If you have selected all the controls together to change Color by mistake, press Ctrl+Z (undo).

The position of the 3D-Text shadow can be controlled by the First Parameter to the Function and the following Values are used:

0 - Shadow tilted to Left top corner

1 - Left Bottom Corner

2 - Right top Corner

3 - Bottom Right corner

The Second Parameter Value 0 creates Label based 3D-Heading and 1 creates TextBox based 3D-Heading with it’s Control Source Property set with a Formula to display the Text. On the TextBox’s Control Source Property you may change to Display Values from the underlying Data Fields (of Tables/Queries) which will change when the Records are moved from one to the other on your Data Editing Form.

Tip: You may omit the second parameter while running the Function, if you need only a Label based 3D-Heading.

Labels: msaccess tips

Microsoft Access (the Relational Database Management System), is the Jewell among Ms-Office Suite of Applications, comes with superior Designing Tools and with built-in Visual Basic Language. These Pages are not intended for Beginner’s Tutorial Lessons but for those who have at least some basic knowledge of Designing MS-Access Tables, Queries, Forms, Reports, Macros and have general understanding of Visual Basic (the Programming Language of all MS-Office Applications) Modules, Function Procedures, Event Procedures etc.

When we develop an Application under any Database Management System it should be User-friendly and visually pleasing too. An un-attractive design spoils the appeal of the whole Project and it reflects the developer’s lack of creativity and indirectly reflects his inability to approach data processing problems effectively as well.

You can cook good food in the Kitchen but if the final presentation on the Table is bad then all the efforts put behind the scene doesn’t get the attention that it deserves. Like the saying goes, “face is the mirror of mind”, attractively designed Screens and Reports definitely have an appeal to the Users.

First, ensure that the essential Reference Library Files are attached to your Project. Display the Visual Basic Editor Window. Select Visual Basic Editor Option from Tools Menu or Code from View Menu. On the Visual Basic Editor Window Select References… from Tools Menu. Put check mark on the following Library Files in the Available References Dialogue Control:

1. Visual Basic for Applications
2. Microsoft Access 11.0 Object Library
3. OLE Automation
4. Microsoft DAO 3.6 Object Library
5. Microsoft ActiveX Data Objects 2.5 Library
6. Microsoft Office 11.0 Object Library
7. Microsoft Visual Basic for Applications Extensibility 5.3

The Version Numbers of Library Files will be different based on what MS-Office version you are using. The Library File's List will be in alphabetical order. After you put check marks all the selected items will appear in the list on the top.

Public Function ButtonAnimate(ByVal strForm As String, _
ByVal mode As Integer, ByVal lblName As String)
'------------------------------------------------------------
'Command Button Animation
'Author : a.p.r. pillai
'Date : September 2006
'------------------------------------------------------------
Dim FRM As Form, l As Long, t As Long

On Error GoTo ButtonAnimate_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)' 0.0208 inches
   FRM.Controls(lblName).Top = t - (0.0208 * 1440)' 0.0208 inches
   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

ButtonAnimate_Exit:
Exit Function

ButtonAnimate_Err:
'Err.Clear

Resume ButtonAnimate_Exit
End Function

Name = cmdClose
Caption = Close
ControlTipText = Click

Name  =  cmdCloseBox

Visible       = False
SpecialEffect = Shadowed
BorderColor   = 0
BorderStyle   = Solid
BackStyle     = Transparent

Private Sub cmdClose_MouseMove(Button as Integer, _
Shift as Integer, X as Single, Y as single)

    ButtonAnimate Me.Name, 1, "cmdClose"

End Sub


Private Sub FormFooter_MouseMove(Button as Integer, _
Shift As Integer, X As Single, Y As Single)

ButtonAnimate Me.Name, 0, "cmdClose"


End Sub

6. Open the Form in Normal View and try moving the Mouse over the Command Button and over the blank area of the Form Footer in a continuous stroke. When the Mouse is over the Button the Button moves slightly up and to the left showing up the Rectangle Frame as if it is the shadow of the Command Button and when the Mouse is dragged over the blank area of the Form Footer the Button goes back to its original state hiding the shadow. When this action is repeated the Button becomes lively and responds to the User every time the mouse is passed over the Button.

Any Number of Command Buttons can be added this way at the Form Footer (or Form Header Section, Detail Section) by placing the code for MouseMove Events. When the ButtonAnimate() Function is called, the Function Parameter Value 1 moves the Button up and 0 brings it back to its original position. If more than One button is added at the Footer, each Button should have its own Call to the ButtonAnimate() Function with 1 & 0 Values at the Command Button & Form Footer MouseMove Event Procedures respectively. --oOo--
Next >> Create 3D Text Headings on Forms and Reports

Labels: msaccess animation