Manufacturing Information Solutions Forum Index Manufacturing Information Solutions
Your Place for Support and Discussions
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Useful Modules and Subs

 
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft Access
View previous topic :: View next topic  
Author Message
BIGmiralli
Frequent Poster


Joined: 17 Apr 2007
Posts: 38
Location: Boston, Massachusetts

PostPosted: Fri May 23, 2008 12:40 pm    Post subject: Useful Modules and Subs Reply with quote

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
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft Access All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group