BIGmiralli Frequent Poster
Joined: 17 Apr 2007 Posts: 38 Location: Boston, Massachusetts
|
Posted: Fri May 23, 2008 12:40 pm Post subject: Useful Modules and Subs |
|
|
Functions:
Code: | Public Function CmToTwips(CM As Double) As Double
CmToTwips = CM * 567
End Function
Public Function IsLoaded(ByVal strFormName As String) As Boolean
' Returns True if the specified form is open in Form view or Datasheet view.
Const conObjStateClosed = 0
Const conDesignView = 0
If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> conObjStateClosed Then
If Forms(strFormName).CurrentView <> conDesignView Then
IsLoaded = True
End If
End If
End Function
Public Function CloseObject(strContainerName As String, intContainerType As Integer)
' Close open database objects.
Dim Dbs As Database, ctr As Container
Dim intX As Integer
Set Dbs = CurrentDb
Set ctr = Dbs.Containers(strContainerName)
For intX = 0 To ctr.Documents.Count - 1
DoCmd.Close intContainerType, ctr.Documents(intX).Name
Next intX
Set Dbs = Nothing
End Function
Public Function NulltoZero(Item As Variant) As Variant
If IsNull(Item) Then Item = 0
If IsEmpty(Item) Then Item = 0
NulltoZero = Item
End Function
Public Function NulltoZeroString(Item As Variant) As Variant
If IsNull(Item) Then Item = ""
If IsEmpty(Item) Then Item = ""
NulltoZeroString = Item
End Function
Public Function LastWord(Sentance As String) As String
Dim iSpacePos As Integer
Dim iNextSpace As Integer
iSpacePos = InStr(Sentance, " ")
'deal with no spaces
If iSpacePos = 0 Then
LastWord = Sentance
Exit Function
End If
'find the last space
Do
iNextSpace = InStr(iSpacePos + 1, Sentance, " ")
If iNextSpace > 0 Then iSpacePos = iNextSpace
Loop Until iNextSpace = 0
'return the value from the last space
LastWord = Right(Sentance, Len(Sentance) - iSpacePos)
End Function
Public Function FirstWord(Sentance As String) As String
Dim iSpacePos As Integer
Dim iNextSpace As Integer
iSpacePos = InStr(Sentance, " ")
'deal with no spaces
If iSpacePos = 0 Then
FirstWord = Sentance
Exit Function
End If
'return the value from the last space
FirstWord = Right(Sentance, Len(Sentance) - iSpacePos)
End Function |
Subs:
Code: |
Option Compare Database
Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Declarations used by MaximizeRestoredForm
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Type Rect
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As Rect) As Long
Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal _
nCmdShow As Long) As Long
Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal _
X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight _
As Long, ByVal bRepaint As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNORMAL = 1
Sub MaximizeRestoredForm(F As Form)
Dim MDIRect As Rect
Const ScrlBar As Integer = 5
' If the form is maximized, restore it.
If IsZoomed(F.hwnd) <> 0 Then
ShowWindow F.hwnd, SW_SHOWNORMAL
End If
' Get the screen coordinates and window size of the
' MDIClient window.
GetWindowRect GetParent(F.hwnd), MDIRect
' Move the form to the upper left corner of the MDIClient
' window (0,0) and size it to the same size as the
' MDIClient window.
MoveWindow F.hwnd, 0, 0, MDIRect.x2 - MDIRect.x1 - ScrlBar, _
MDIRect.y2 - MDIRect.y1 - ScrlBar, True
End Sub
Public Sub ShowForm(FormName As String)
On Error Resume Next
DoCmd.Hourglass (True)
DoCmd.SetWarnings False
DoCmd.OpenForm FormName
DoCmd.SetWarnings True
DoCmd.Hourglass (False)
End Sub
Public Sub ShowDialog(FormName As String)
On Error Resume Next
DoCmd.Hourglass (True)
DoCmd.SetWarnings False
DoCmd.Hourglass (False)
DoCmd.OpenForm FormName, acNormal, , , acFormEdit, acDialog
DoCmd.SetWarnings True
End Sub
'show a form as a table
Public Sub ShowTable(FormName As String)
On Error Resume Next
DoCmd.Hourglass (True)
DoCmd.OpenForm FormName, acFormDS
DoCmd.Hourglass (False)
End Sub
Public Sub RunReport(ReportName As String, Optional ViewMode)
On Error Resume Next
If IsMissing(ViewMode) Then ViewMode = acPreview
DoCmd.Hourglass (True)
DoCmd.SetWarnings False
DoCmd.OpenReport ReportName, ViewMode
If ViewMode = acPreview Then DoCmd.Maximize
DoCmd.SetWarnings True
DoCmd.Hourglass (False)
End Sub
Public Sub ClearTable(TableName As String)
On Error Resume Next
Dim strSQL As String
DoCmd.Hourglass (True)
DoCmd.SetWarnings False
strSQL = "delete * from " & TableName
DoCmd.RunSQL (strSQL)
DoCmd.Hourglass (False)
DoCmd.SetWarnings True
End Sub
Public Sub RunQuery(QueryName As String)
On Error Resume Next
DoCmd.Hourglass (True)
DoCmd.SetWarnings False
DoCmd.OpenQuery QueryName, acNormal, acEdit
DoCmd.Hourglass (False)
DoCmd.SetWarnings True
End Sub
Public Sub ShowFilteredForm(FormName As String, Filtertext As String)
On Error Resume Next
DoCmd.Hourglass (True)
DoCmd.OpenForm FormName, , , Filtertext
DoCmd.Hourglass (False)
End Sub
Public Sub RunFilteredReport(ReportName As String, Filtertext As String, Optional ViewMode)
On Error Resume Next
If IsMissing(ViewMode) Then ViewMode = acPreview
DoCmd.Hourglass (True)
DoCmd.OpenReport ReportName, ViewMode, , Filtertext
If ViewMode = acPreview Then DoCmd.Maximize
DoCmd.Hourglass (False)
End Sub
Public Sub RecordAdd()
On Error Resume Next
DoCmd.GoToRecord , , acNewRec
End Sub
Public Sub RecordDelete()
On Error Resume Next
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
End Sub
Public Sub RecordSave()
On Error Resume Next
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
End Sub
Public Sub JumpToControlValue(SearchField As String, cbobox As ComboBox)
'Find the record that matches the control.
On Error Resume Next
Dim strValue As String
Dim frmHostForm As Object
Screen.MousePointer = 11
If IsNumeric(cbobox.Value) Then
strValue = cbobox.Value
Else
strValue = "'" & cbobox.Value & "'"
End If
Set frmHostForm = cbobox.Parent
frmHostForm.RecordsetClone.FindFirst "[" & SearchField & "] = " & strValue
frmHostForm.Bookmark = frmHostForm.RecordsetClone.Bookmark
Screen.MousePointer = 0
End Sub
Public Sub FormClose()
On Error Resume Next
DoCmd.Close
End Sub
Public Sub FormFilter(TargetForm As Form, Filtertext As String)
With TargetForm
.Filter = Filtertext
.FilterOn = True
End With
End Sub
|
________
Gg duetto |
|