Archivo

Archivo para Marzo 2007

How can I open a form or report in code and make the code wait until that form or report has been closed..

The simple answer for forms is to open the form as a modal dialog box, like this:

DoCmd OpenForm “frmFormName”, , , , , A_DIALOG

Note the commas, the A_DIALOG parameter is the fifth parameter.

Of course, this will not work for reports in preview mode, and may not be the desired result for a particular form, some polling will be called for, e.g.

DoCmd OpenForm "frmFormName"
Do While IsFormLoaded("frmFormName")
  DoEvents
Loop

DoCmd OpenReport "rptReportName"
Do While IsReportLoaded("rptReportName")
  DoEvents
Loop

Then in a global module, the following functions will test if a particular form or report is loaded:

Function IsFormLoaded(pstrFormName As String) As Integer
  IsFormLoaded = SysCmd(SYSCMD_GETOBJECTSTATE, A_FORM, pstrFormName)
End Function

Function IsReportLoaded(pstrReportName As String) As Integer
  IsReportLoaded = SysCmd(SYSCMD_GETOBJECTSTATE, A_REPORT, pstrReportName)
End Function

Categorías:Microsoft Access

Controlar la tabulación del subformulario al formulario

When a user presses the tab key or the enter key when they are in the last field on a main form, where the next field is a sub form, this will automatically result in the cursor moving to the first control in the subform. However, if the user then holds down the Shift key and presses the tab key, (to move backward in the form,) rather than re-entering the main form, the cursor will either move to the last field on the sub form (if on the first record of the sub form,) or to the previous record in the sub form. Similarly, if the user is on the last control in the sub form and presses the enter key, they will be taken to the next record in the sub form, rather than to next control in the main form. This behavior can be modified to progress directly between the main form and current record of the sub form by using event procedures in the “On Key Down” event of the sub-Form’s first and last controls. To do this use the code below. (Note the “Parent” property of the sub form refers to the main form): 1. On the Declarations page of the Form’s module enter the following lines:

Const Key_Tab = &H9
Const Key_Return = &HD
Const SHIFT_MASK = 1

2. In the “On Key Down” event of the first control on the sub-form create an event procedure and enter the following code:

ShiftDown = (Shift And SHIFT_MASK) > 0

   If KeyCode = Key_Tab Then
        If ShiftDown Then
            Me.Parent!SomeControl.SetFocus
            KeyCode=0
       End If
   End If

3. In the “On Key Down” event of the last control on the sub-form create an event procedure and enter the following code:

  ShiftDown = (Shift And SHIFT_MASK) > 0

    If KeyCode = Key_Tab Then
        If ShiftDown = 0 Then
            KeyCode = 0
            Me.Parent!SomeControl.SetFocus
        End if
    ElseIf KeyCode = Key_Return Then
           KeyCode = 0
           Me.Parent!SomeControl.SetFocus
    Else Exit Sub
    End If

To stop the user from re-entering the main form, without moving to the next record, simply remove the lines of code which set the focus on a control of the Main Form.

Access 95 and 97: If you need to trap key actions and movement in Access 95 and 97, especially if it involves multiple controls and/or sub-forms (e.g. sub-forms on a tab control,) you can save time and coding by creating a single function for the form by setting the Key Preview property of the form to “Yes”, and writing a single function in the OnKeyDown event of the form. You can use a select case routine to test the CurrentControl.name and set your form movement from there.

Categorías:Microsoft Access

Listar todos los archivos de una carpeta

Private Sub listarDownloads()
Dim dir As DirectoryInfo = New
DirectoryInfo(Request.MapPath(“Downloads”))
For Each f As FileInfo In dir.GetFiles(“*.*”)
Me.ListaFiles.Items.Add(f.Name)
Next
End Sub

Categorías:Microsoft Access

Listar los archivos doc de una carperta

Esta es una solución un poco rebuscada, pero se puede utilizar el objeto
FileSearch de Office
En mi caso  he hecho referencia a la librería de Word para que funcione,
pero también funcionaría con la referencia a la librería de Excel., y
cambiando Word.Application por Excel.Application
Public Sub BuscarDocumentos( _
ByVal Carpeta As String, _
Optional ByVal Tipo As String = “*.*”)
Dim objWord As Word.Application
Set objWord = New Word.Application
Dim i As Long
Carpeta = Trim(Carpeta)
If Right(Carpeta, 1) <> “\” Then
Carpeta = Carpeta & “\”
End If
With objWord.FileSearch
.LookIn = Carpeta
.FileName = Tipo
.SearchSubFolders = True
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Debug.Print .FoundFiles(i)
Next i
Else
MsgBox “No se han encontrado ficheros”, _
vbInformation + vbOKOnly, _
“Búsqueda en ” _
& .LookIn
End If
End With
End Sub
El objeto FileSearch es muy interesante por la gran cantidad de
posibilidades que tiene.

Categorías:Microsoft Access

Quitar las barras de título de los formulario

'Crea un módulo nuevo y pega este código. Nombre: basQuitarBarraTitulos

Option Compare Database
Option Explicit

Const NombreModulo = "basFormGlobal"

' Store rectangle coordinates.
Type adhTypeRect
    X1 As Long
    Y1 As Long
    x2 As Long
    Y2 As Long
End Type

Declare Function adh_apiIsIconic Lib "user32" _
        Alias "IsIconic" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetDeviceCaps Lib "gdi32" _
        Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Declare Function adh_apiGetWindowRect Lib "user32" _
        Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As adhTypeRect) As Long

Declare Function adh_apiGetParent Lib "user32" _
        Alias "GetParent" (ByVal hWnd As Long) As Long

Declare Function adh_apiGetClientRect Lib "user32" _
        Alias "GetClientRect" (ByVal hWnd As Long, lpRect As adhTypeRect) As Long

Declare Function adh_apiGetWindowLong Lib "user32" _
        Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function adh_apiGetSystemMetrics Lib "user32" _
        Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Declare Function adh_apiGetActiveWindow Lib "user32" _
        Alias "GetActiveWindow" () As Long

'=======================================================================

' Store group/subform dimensions.
Type adhTypeDimensions
    sglLeft As Double
    sglTop As Double
    sglWidth As Double
    sglHeight As Double
    strCtlName As String
End Type

' These are the class names used in Access.
Public Const adhcAccessClass = "OMain"
Public Const adhcMDIClientClass = "MDICLIENT"
Public Const adhcAccessDBCClass = "ODb"
Public Const adhcAccessFormClass = "OForm"

' Windows API declarations.
Declare Function adh_apiCreateIC Lib "gdi32" _
        Alias "CreateICA" (ByVal lpDriverName As String, _
        ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long

Declare Function adh_apiDeleteDC Lib "gdi32" _
        Alias "DeleteDC" (ByVal hdc As Long) As Long

Declare Function adh_apiMoveWindow Lib "user32" _
        Alias "MoveWindow" (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 adh_apiSetWindowLong Lib "user32" _
        Alias "SetWindowLongA" (ByVal hWnd As Long, _
        ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function adh_apiGetWindow Lib "user32" _
        Alias "GetWindow" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Declare Function adh_apiGetClassName Lib "user32" _
        Alias "GetClassNameA" (ByVal hWnd As Long, _
        ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Declare Function adh_apiFindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

Declare Function adh_apiGetNextWindow Lib "user32" _
        Alias "GetNextWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long

Declare Function adh_apiSetFocus Lib "user32" _
        Alias "SetFocus" (ByVal hWnd As Long) As Long

' Get a string from a private INI file.  Returns the number of bytes
' copied into strReturned, not including the trailing null.
Declare Function adh_apiGetPrivateProfileString Lib "kernel32" _
        Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal lpDefault As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long, _
        ByVal lpFileName As String) As Long

' Write a string to a private INI file.  Returns a non-zero value if successful,
' otherwise it returns a 0.
Declare Function adh_apiWritePrivateProfileString Lib "kernel32" _
        Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal lpString As String, _
        ByVal lpFileName As String) As Long

' These functions aren't actually used
' but are provided here for reference only.

' Get a string from WIN.INI. Returns the number of bytes copied into strReturned,
' not including the trailing null.
Declare Function adh_apiGetProfileString Lib "kernel32" _
        Alias "GetProfileStringA" (ByVal lpadhcAppName As String, _
        ByVal lpKeyName As String, ByVal lpDefault As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long) As Long

' Get an integer from WIN.INI.  Returns either the integer it found,
' or the value sent in intDefault.
Declare Function adh_apiGetProfileInt Lib "kernel32" _
        Alias "GetProfileIntA" (ByVal lpadhcAppName As String, _
        ByVal lpKeyName As String, ByVal nDefault As Long) As Long

' Write a string to WIN.INI.  Returns a non-zero value if successful,
' otherwise it returns a 0.
Declare Function WriteProfileString Lib "kernel32" _
        Alias "WriteProfileStringA" (ByVal lpszSection As String, _
        ByVal lpszKeyName As String, ByVal lpszString As String) As Long

' Get an integer from a private INI file. Returns either the integer it found,
' or the value sent in intDefault.
Declare Function GetPrivateProfileInt Lib "kernel32" _
        Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal nDefault As Long, _
        ByVal lpFileName As String) As Long

' GetNextWindow() constants
Public Const adhcGW_CHILD = 5
Public Const adhcGW_HWNDNEXT = 2

' Windows API Constants
Public Const adhcVERTRES = 10
Public Const adhcHORZRES = 8
Public Const adhcLOGPIXELSX = 88
Public Const adhcLOGPIXELSY = 90

' General Constants
Public Const adhcTwipsPerInch = 1440

' GetWindowLong Constant
Public Const adhcGWL_STYLE = -16

' Windows Style constant
Public Const adhcWS_CAPTION = &HC00000

' System Metrics Constant
Public Const adhcSM_CYCAPTION = 4
Public Const adhcSM_CXFULLSCREEN = 16
Public Const adhcSM_CYFULLSCREEN = 17

'Para quitar la barra de título de de cualquier formulario.
'En el evento, "Al abrir el formulario" : Call adhRemoveCaptionBar(Me)

Function adhRemoveCaptionBar(Frm As Form)
On Error GoTo Err_adhRemoveCaptionBar
    adhRemoveWindowCaptionBar Frm.hWnd
    Exit Function
Err_adhRemoveCaptionBar:
    MsgBox Err.Description
End Function

Sub adhRemoveWindowCaptionBar(ByVal hWnd As Long)
On Error GoTo Err_adhRemoveWindowCaptionBar

    Dim lngOldStyle As Long
    Dim lngNewStyle As Long
    Dim rct As adhTypeRect
    Dim intDX As Integer, intDY As Integer

    ' Get the current window style of the form.
    lngOldStyle = adh_apiGetWindowLong(hWnd, adhcGWL_STYLE)

    ' Turn off the bit that enables the caption.
    lngNewStyle = lngOldStyle And Not adhcWS_CAPTION

    ' Set the new window style.
    lngOldStyle = adh_apiSetWindowLong(hWnd, adhcGWL_STYLE, lngNewStyle)

    ' The caption's been removed, but now resize
    ' the whole window to match the size of the interior.

    ' Get the current size, including the caption.
    adh_apiGetWindowRect hWnd, rct

    ' Calculate the new width and height.

'    intDX = 648
'    intDY = 466

    intDX = rct.x2 - rct.X1
    intDY = rct.Y2 - rct.Y1 - _
     adh_apiGetSystemMetrics(adhcSM_CYCAPTION)

    ' Move the window to the same left and top,
    ' but with new width and height.
    ' This will make the new form appear
    ' a little lower than the original.
    Call adh_apiMoveWindow(hWnd, rct.X1, _
     rct.Y1, intDX, intDY, True)
    Exit Sub
Err_adhRemoveWindowCaptionBar:
    MsgBox Err.Description
End Sub

Sub RemoveAccessCaptionBar()
On Error GoTo Err_RemoveAccessCaptionBar
    ' Not terribly useful, but this procedure will remove the
    ' main Access caption bar!
    Call adhRemoveWindowCaptionBar2(Application.hWndAccessApp)
    Exit Sub
Err_RemoveAccessCaptionBar:
    MsgBox Err.Description
End Sub

Sub adhRemoveWindowCaptionBar2(ByVal hWnd As Long)
On Error GoTo Err_adhRemoveWindowCaptionBar

    Dim lngOldStyle As Long
    Dim lngNewStyle As Long
    Dim rct As adhTypeRect
    Dim intDX As Integer, intDY As Integer

    ' Get the current window style of the form.
    lngOldStyle = adh_apiGetWindowLong(hWnd, adhcGWL_STYLE)

    ' Turn off the bit that enables the caption.
    lngNewStyle = lngOldStyle And Not adhcWS_CAPTION

    ' Set the new window style.
    lngOldStyle = adh_apiSetWindowLong(hWnd, adhcGWL_STYLE, lngNewStyle)

    ' The caption's been removed, but now resize
    ' the whole window to match the size of the interior.

    ' Get the current size, including the caption.
    adh_apiGetWindowRect hWnd, rct

    ' Calculate the new width and height.
    intDX = rct.x2 - rct.X1
    intDY = rct.Y2 - rct.Y1 - _
     adh_apiGetSystemMetrics(adhcSM_CYCAPTION)

    ' Move the window to the same left and top,
    ' but with new width and height.
    ' This will make the new form appear
    ' a little lower than the original.
    Call adh_apiMoveWindow(hWnd, rct.X1, _
     rct.Y1, intDX, intDY + 20, True)
    Exit Sub
Err_adhRemoveWindowCaptionBar:
    MsgBox Err.Description
End Sub
Categorías:Microsoft Access