Mensajes recientes

Páginas: [1] 2 3 ... 10
1
Formularios / Colores en cuadro combinado y cuadro de lista
« Último mensaje por xavi en Junio 09, 2020, 08:14:37 pm »
Palabras clave: formulario, cuadro combinado, combobox, cuadro de lista, listbox, color, formato
Autor: Neckkito
Extraído de: Web de Neckkito

A raíz de una pregunta en el Foro de Access y VBA sobre como colorear registros en ComboBox y ListBox descubro esta pequeña joya.

El truco es utilizar los argumentos de la propiedad Formato que acostumbramos a "despreciar" (obviamente de forma prepotente)

Link al ejemplo (incluye PDF y ejemplo)

¡Gracias Miquel!
2
Formularios / Propiedades personalizadas en formularios
« Último mensaje por xavi en Junio 04, 2020, 12:59:43 pm »
Palabras clave: formulario, propiedad, personalizada
Autor: Chea
Extraído de: Hilo de MVP-Access + Teams AUGE

Antecedentes
El usuario Dabellaso pregunta en el foro sobre la posibilidad de asignar propiedades personalizadas a un formulario.

Al mirar la ayuda de Microsoft se lee que solo se pueden definir para los objetos Index, QueryDef y TableDef.

Posteriormente en el Teams de AUGE, Chea nos explicó que si que existe una forma de asignar propiedades a formularios.

Cita de: Chea
En realidad las propiedades no se guardan en los formularios, sino en el objeto correspondiente de la colección AllForms. Se usa de la misma manera que haríamos para una propiedad personalizada de la base de datos, pero haciendo referencia a AllForms("miformulario"). Por ejemplo:
 
Para añadir la propiedad:
CurrentProject.AllForms("frmVisorFacturae").Properties.Add "InterfazFirma", True
 
Para cambiarle el valor:
 
CurrentProject.AllForms("frmVisorFacturae").Properties("InterfazFirma") = blnNewValue
 
Para leer el valor:
UsarInterfazFirma = CurrentProject.AllForms("frmVisorFacturae").Properties("InterfazFirma")
 
Yo lo que hago para que el manejo final me resulte más sencillo es crearme una pareja de procedimientos Property en el módulo del formulario para leer y escribir esa Propiedad.

Al meterlo en los procedimientos Property el resultado es como si usáramos una variable persistente entre sesiones. Le decimos dentro del formulario InterfazFirma = True y ahí se queda hasta que no lo cambiemos aunque cerremos la aplicación.

Horus pregunta: Tengo una duda. Si lo hacemos así, en realidad la propiedad es del formulario en el que la hayamos agregado, no es común para todos los formularios. ¿Es correcto?

Respuesta:En puridad no es una propiedad del formulario, porque no se encuentra en el propio formulario, sino en el AccessObject correspondiente a ese formulario en la colección AllForms. Sin embargo, como esos objetos contienen información de cada formulario, en cierto modo podríamos decir que es una propiedad del formulario. No podemos decir Forms!Miformulario.Mipropiedad, pero sí podemos decir CurrentProject.AllForms("Miformulario").Mipropiedad. Y, efectivamente, la propiedad es para un formulario concreto, no para todos.
3
Varias / SysCmd Indocumentado
« Último mensaje por xavi en Mayo 26, 2020, 04:03:57 pm »
Palabras clave: SysCmd, oculto, indocumentado
Autor: Wayne Phillips
Extraído de: EverythingAccess.com

Rebuscando un tema, me he topado con esta página dónde se explican (por encima) algunas funciones de SysCmd no documentadas.

El artículo es muy antiguo (Abril 2005) pero es posible que algunas cosas continúen realmente ocultas.

(Traducción de Google Translate)
NOTA: lo copio y traduzco por si la página se pierde.


Funciones SysCmd no documentadas
por Wayne Phillips, 19 de abril de 2005 (para Access 97+)

Aquí hay algunos detalles sobre una selección de funciones SysCmd 'no documentadas'. Puede usarlos en sus aplicaciones de base de datos de Access para hacer cosas que generalmente no se pueden hacer fácilmente a través del Modelo de Objetos de Access (si es que lo hace).

Estos detalles provienen de varias fuentes, incluida mi propia investigación. Es probable que no sean 100% precisos y definitivamente no son oficiales ni compatibles con Microsoft: ¡ úselos bajo su propio riesgo!

SysCmd (603, strPathInputMdb, strPathOutputMde) - CONVERTIR MDB A MDE
Convierte un archivo MDB en un MDE. Dado que toma el archivo fuente como parámetro, no puede convertir la base de datos actualmente abierta usando Access VBA; en su lugar, debe llamar a esto desde otra aplicación / instancia:

 
    SysCmd 603, strPathInputMdb, strPathOutputMde

O, mediante el uso de la automatización (por ejemplo, en VB6):

        Dim objAccess As Object

        'Crear el objeto de Automatización de acceso
        Establecer objAccess = CreateObject ("Access.Application")

        ' Ahora llame a la función no documentada ...
        objAccess.SysCmd 602, strPathSourceMdb, strPathDestinationMdb

        Establecer objAccess = Nothing
Nota: debe asegurarse de estar utilizando la versión correcta de Access para crear el MDE (es decir, si es un archivo MDB de Access 2000, solo puede crear un MDE a partir de él utilizando Access 2000, no Access 2002/2003).

* ACTUALIZACIÓN * : parece que puede usar Access XP / 2003 para crear un archivo Access 2000 MDE con este método, sin embargo , tenga mucho cuidado ya que es muy probable que falle debido a las pequeñas diferencias en el código VBA compilado, las referencias y el acceso modelo de objeto, etc. Mi recomendación es olvidar que existe este agujero de bucle.

 *Comentario al pie*
   
Parece que la conversión a ADE o MDE con este método puede fallar si el origen y el destino se pasan como variables recargables.
Para forzar que estas variables pasen byval o desreferenciarlas, ajuste cada una en una llamada de función como VBA.Trim (sourcedb) etc.
por ejemplo:
app.SysCmd 603, VBA.Trim (sourceFile_), VBA.Trim (compiledFileName_ )

Esta fue mi experiencia al usar Access 2010 en Windows 7.
Si pasaba las variables directamente, un nombre de archivo unicode escalado aparecería en un directorio padre para el destdb y la función no encontraría el sourcedb si dejaba el sourcedb usando la variable directa.

Espero que esto ayude.

SysCmd (609) - OBTENER ID DE PROCESO DE LA INSTANCIA ACTUAL - MSACCESS.EXE - Solo Access 2000+
Devuelve el PID (ID de proceso) del proceso MSAccess.exe actualmente en ejecución. Esto sería muy útil para algunas llamadas a la API de Windows ...

 

SysCmd (504, Flag) - COMPILAR MÓDULOS VBA
Donde el indicador puede ser 16483 para indicar 'Guardar VBA con código compilado' o 16484 para 'Guardar VBA sin código compilado'.

Flag también puede ser 16481 y 16482, pero la funcionalidad es desconocida en la actualidad.

 

SysCmd (602, strPathSourceMdb, [strPathDestinationMdb]) - BASE DE DATOS COMPACTA - Solo Access 97
Compactar (no reparar) una base de datos. No puede compactar la base de datos * abierta * con este método; en su lugar, debe llamarla desde otra aplicación / instancia:

        Dim objAccess As Object

        'Create the Access Automation object
        Set objAccess = CreateObject ("Access.Application")

        ' Ahora llame a la función no documentada ...
        objAccess.SysCmd 602, strPathSourceMdb, strPathDestinationMdb

        Set objAccess = Nothing
Nota: Si desea compactar un archivo sin crear una 'copia' (es decir, compactar el archivo en su lugar), simplemente omita el parámetro strPathDestinationMdb.

 

SysCmd (555) - CREACIÓN DE FUERZA DE MSysIMEXSpecs Y MSysIMEXColumns
Las dos tablas que se utilizan para almacenar configuraciones de importación / exportación utilizadas por Access no se crean de forma predeterminada. Llamar a esta función los creará para usted.

 

SysCmd (500) - CONTEO DE REFERENCIAS VBA - Solo Access 97
El valor de retorno es el mismo que Access.References.Count.

 

SysCmd (501, intReferenceOrdinal) - CADENA ALMACENADA SIN PROCESAR DE REFERENCIAS VBA - Solo Access 97
Donde 0 <= intReferenceOrdinal <= SysCmd (500)

Para cada referencia de VBA, esto devolverá la cadena codificada que contiene todas las propiedades de referencia (# delimitador) (por ejemplo, GUID # MajorVersion # MinorVersion # LibraryPath # Name)

Algo así como '* \ G {00025E01-0000-0000-C000-000000000046} # 4.0 # 0 # C: \ Archivos de programa \ Archivos comunes \ Microsoft Shared \ DAO \ DAO350.DLL # Biblioteca de objetos Microsoft DAO 3.51'

 

SysCmd (605, strPathOutput) - CONVERTIR BASE DE DATOS PARA ACCEDER AL FORMATO 97 - Solo Access 2000+
Convierta la base de datos actual al formato Access 97. Si strPathOutput = 0, se solicita la ruta de salida.

En Access 2002/2003, esto es lo mismo que Access.ConvertAccessProject strSourcePath, strDestinationPath, acFileFormatAccess97

 

SysCmd (607, strProjectPath) - CONVERTIR A PROYECTO ADP SIN TABLAS / CONSULTAS  - Solo Access 2000+
Este comando crea un nuevo proyecto ADP e importa los componentes que no son Jet de la base de datos actualmente abierta (por ejemplo, formularios / informes / módulos vba).

Nota: Esto no es lo mismo que el Asistente de conversión, ya que no hace nada con las tablas o consultas.

 

SysCmd (608, intTipID) - VEA LOS CONSEJOS DEL ASISTENTE DE OFICINA COMO CADENAS - Solo Access 2000+
Estos son los consejos utilizados por el Asistente de Office, accesibles por número ordinal (0-60).

 

SysCmd (710, InputLocaleID) - CONFIGURAR EL TIPO DE TECLADO DE INSTANCIA DE APLICACIÓN
Esta llamada es un contenedor para la función Win32 API ActivateKeyboardLayout .

Esta configuración afecta solo a la instancia actual de la aplicación y no se guarda con la base de datos (deberá configurarla dentro de la rutina de inicio de sus aplicaciones para que sea semipermanente). El indicador de entrada se denomina 'identificador de configuración regional de entrada' (consulte los documentos de la API para obtener más información). Ejemplos de valores comunes (observe las repeticiones de palabras altas / bajas):

    InputLocaleID = & H08090809: británico

    InputLocaleID = & H04090409: inglés de EE. UU.

    InputLocaleID = & 04150415: polaco

    InputLocaleID = & 04190419: ruso

    InputLocaleID = & H04080408: griego

 

SysCmd (711) - OBTENGA EL TIPO DE TECLADO DE INSTANCIA DE APLICACIÓN
Esta llamada es un contenedor para la función Win32 API GetKeyboardLayout .

Este comando devuelve las aplicaciones InputLocaleID actual (solo instancia actual).   Consulte los indicadores del comando anterior (710).

 

SysCmd (714) - ¿HAY ALGUNOS OBJETOS DE ACCESO EN LA VISTA DE DISEÑO?
Devuelve un valor booleano (verdadero / falso): verdadero si algún formulario, informe, DAP, macro o módulo está actualmente abierto en modo de diseño.

 

SysCmd (715) - VERSIÓN DE CONSTRUCCIÓN DE ACCESS
Devuelve el número de compilación de la versión de Access que se está ejecutando. Combine este valor con la constante acSysCmdAccessVer SysCmd y luego podrá determinar el paquete de servicio, por ejemplo:

    SysCmd (acSysCmdAccessVer) = 9 -> Access 2000

        SysCmd (715) = 2719 'Access 2000 Sin Service Pack

        SysCmd (715) = 3822 'Access 2000 SP1

        SysCmd (715) = 4506 'Access 2000 SP2

        SysCmd (715) = 6620 'Access 2000 SP3

    SysCmd (acSysCmdAccessVer) = 10 -> Acceso 2002

        SysCmd (715) = 2627 'Access 2002 (XP) Sin Service Pack

        SysCmd (715) = 3409 'Access 2002 (XP) SP1

        SysCmd (715) = 4302 'Access 2002 (XP) SP2

        SysCmd (715) = 6501 'Access 2002 (XP) SP3

    SysCmd (acSysCmdAccessVer) = 11 -> Access 2003

        SysCmd (715) = 5614 'Access 2003 Sin Service Pack

        SysCmd (715) = 6355 'Access 2003 SP1

        SysCmd (715) = 6566 'Access 2003 SP2


 

SysCmd (712) - OBTENGA IPictureDisp DESDE EL CONTROL DE IMAGEN - Solo Access 2000+
Devuelve un puntero a la interfaz IPictureDisp detrás de un control de imagen.

 


4
Páginas amigas / Otros links
« Último mensaje por xavi en Mayo 13, 2020, 02:05:01 pm »
5
General / Citas
« Último mensaje por xavi en Mayo 07, 2020, 01:08:33 am »
"Siempre codifica como si el tipo que termina manteniendo tu código sea un psicópata violento que sabe dónde vives " .
"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live."
- Martin Golding


"Tienen computadoras y pueden tener otras armas de destrucción masiva"
"They have computers, and they may have other weapons of mass destruction."

- Janet Reno


"Nunca atribuya a la malicia lo que se explica adecuadamente por la estupidez."
"Never attribute to malice that which is adequately explained by stupidity."

- Hanlon's Razor



"La tecnología está dominada por dos tipos de personas: los que entienden lo que no gestionan y los que gestionan lo que no entienden "
"Technology is dominated by two types of people: those who understand what they do not manage, and those who manage what they do not understand."

- Putt's Law



" No hay errores significativos en nuestro software lanzado que un número significativo de usuarios quiera solucionar " .
"There are no significant bugs in our released software that any significant number of users want fixed."

- Bill Gates



" Si el automóvil hubiera seguido el mismo desarrollo que la computadora, un Rolls-Royce costaría hoy $ 100, obtendría un millón de millas por galón y explotaría una vez al año matando a todos los que están dentro "
"If the automobile had followed the same development as the computer, a Rolls-Royce would today cost $100, get a million miles per gallon, and explode once a year killing everyone inside."

- Robert Cringely

6
Formularios / Propiedades etiqueta asociada a un control
« Último mensaje por xavi en Mayo 05, 2020, 03:36:22 pm »
Palabras clave: etiqueta, label, asociada, vinculada, control
Autor: xavi y Duane Hookom
Extraído de: experiencia propia y un ejemplo de UtterAccess muy antiguo

Objetivo:
Obtener propiedades de la etiqueta asociada a un control, por ejemplo, un cuadro de texto sabiendo el nombre del cuadro de texto.

La nueva versión 2019 incorpora una propiedad llamada "Nombre de etiqueta" que permite asociar una etiqueta existente a un control. Antes, como dice este artículo era necesario cortar la etiqueta, clicar el control y pegar la etiqueta. De esa forma se asociaban ambos controles.

El "problema" es acceder a la propiedad desde VBA.

Si investigamos nos encontramos que su nombre es LabelName. Pero resulta que, desde código, no aparece  ???

La forma de acceder es "indirecta": Me!nombrecontrol.Properties("LabelName")


Ahora bien... ¿y como acceder en versiones anteriores?
Esto lo he sacado de un ejemplo muy antiguo, del 2007, de UtterAccess. Pero el código es más antiguo aún: 1998. Autor: de Duane Hooko


Pues accediendo a la colección Controles del control. Si la cuenta de controles del control es superior a 0, el ítem 0 de la colección es la etiqueta. Referenciando ese control podemos acceder a sus propiedades.

Código: [Seleccionar]
' Asignamos el control
Set ctrl = Screen.ActiveControl
' Desactivamos momentáneamente el control de errores por si alguna propiedad fallara
On Error Resume Next
' Si el contador de controles del control es superior a 0
If ctrl.Controls.Count > 0 Then
  ' Tomamos el ítem 0 de la colección y accedemos a sus propiedades
  Debug.Print "Nombre: " & ctrl.Controls(0).Name
  Debug.Print "Caption: " & ctrl.Controls(0).Caption
End If
' Reactivamos el control de errores
On Error GoTo ErrorHandler
7
Consejos, técnicas, artículos / ¿Referenciar o no referenciar? Esa es la cuestión
« Último mensaje por xavi en Mayo 04, 2020, 10:12:43 am »
Palabras clave: librerías, bibliotecas, referencias, Object
Autor: xavi
Extraído de: experiencia propia

Si bien se han publicado diferentes ejemplos sobre la forma de gestionar las referencias de nuestras aplicaciones, yo nunca he con seguido que funcionen. Para mi es complicado entender que, si un código no se ejecuta por referencias, el propio código *que no puede ejecutarse* lo pueda corregir. Así que presento la solución que yo he aplicado.

En mis aplicaciones es muy usual que se interactue con Excel por lo que, durante el desarrollo, es mucho más cómodo tener marcada la referencia de Excel para tener a mano los comandos con el IntelliSense  y las constantes.
El problema es la disparidad de versiones que Office que conviven y que los chicos de Microsoft han resuelto bastante bien la "subida" de referencias pero en absoluto la "bajada".
Tabla de versiones
200712.0
201014.0
201315.0
201616.0


En los siguientes escenarios se marca la referencia en desarrollo y no se desmarca al enviar la aplicación al cliente.

Escenario 1
Desarrollamos en Office 2013
Cliente dispone de Office 2013 o 2016

Al enviar nuestra aplicación al cliente, aquellos PC's con Office 2013 mantendrán la versión 15.0 de la librería; los que tuvieran 2016, "subirían" a 16.0

Escenario 2
Desarrollamos en Office 2016
Cliente dispone de Office 2013 o inferiores

Al enviar la aplicación al cliente, todos los PC's mantendrán la versión 16.0 y, como ninguno de ellos la tiene instalada, obtendremos un error y no podremos ejecutar la aplicación.

Caso especial
Aplicaciones desarrolladas en versiones antiguas (97, 2000) que tienen referencias a otras aplicaciones Office de esas versiones (8.0, 9.0) no son capaces de "subir" la versión cuando se ejecutan en, por ejemplo, una versión 2010.

Así pues, podemos tener un problema entre la comodidad de programar con las referencias y la distribución de las aplicaciones.

Dado que tener todas las versiones de las librerías de Office  se antoja complicado, la solución pasa por entregar la aplicación sin las referencias de Office. Para cambiar a trabajar sin referencias es necesario cambiar nuestra táctica de declaración. Lo que hasta ahora declarábamos como Excel.Application habrá que declararlo como Object. Ello nos privará del IntelliSense y del acceso a las constantes específicas de la aplicación Office que queramos utilizar.

¿Como solucionamos eso? Expongo mi técnica.

Supongo que todos sabemos como funcionan las directivas de compilador (aquí faltaría un link) por lo que nos podemos apoyar en ellas para crear nuestra propia directiva.

En un módulo independiente definimos nuestras propias constantes a modo de directiva:

' Constante de utilización de librerías de Office
#Const UseOL_XLS = False
#Const UseOL_OLK = False


A continuación ponemos una directiva:

#If UseOL_XLS Then
  Public xlsApp As Excel.Application
#Else
  Public xlsApp As Object
#End If


Nota: desde este momento yo dejo de declarar xlsApp cada vez que lo necesito. Habitualmente solo trabajo con un fichero de Excel por que lo que puedo utilizar una variable Public. En caso de necesitar declarar en un procedimiento específico otra instancia de Excel utilizaría la misma técnica:

#If UseOL_XLS Then
  Dim xlsAppOtro As Excel.Application
#Else
  Dim xlsAppOtro As Object
#End If


Durante el desarrollo marco la referencia de Excel y cambio la constante UseOL_XLS a True para poder acceder a los métodos y constantes de Excel.

¿Y las constantes específicas de la otra aplicación?
Pues para las constantes hay que ir manteniendo una lista en la zona #Else de manera que, cuando no tengamos marcada la librería, siga funcionando.

Ejemplos de constantes:

    Public Const xlVeryHidden = 2
    Public Const xlPrintNoComments = -4142
    Public Const xlLandscape = 2
    Public Const xlAutomatic = -4105
    Public Const xlDownThenOver = 1
    Public Const xlPrintErrorsDisplayed = 0
    Public Const xlDown = -4121
    Public Const xlUp = -4162
    Public Const xlLeft = -4159
    Public Const xlRight = -4161
    Public Const xlCenter = -4108
    Public Const xlBottom = -4107
    Public Const xlToLeft = -4159
    Public Const xlToRight = -4161
    Public Const xlEdgeLeft = 7
    Public Const xlEdgeTop = 8
    Public Const xlEdgeBottom = 9
    Public Const xlEdgeRight = 10
    Public Const xlInsideVertical = 11
    Public Const xlInsideHorizontal = 12
    Public Const xlContinuous = 1
    Public Const xlColorIndexAutomatic = -4105
    Public Const xlHairline = 1
    Public Const xlMedium = -4138
    Public Const xlThick = 4
    Public Const xlThin = 2
   

La precaución que debemos tener a la hora de programar es la de añadir cualquier nueva constante que utilicemos.

¿Y a la hora de distribuir?
Sencillo.
- Quitar la referencia de Excel
- Cambiar la constante UseOL_XLS a False
- Compilar por si me hubiera dejado alguna constante no definida o alguna "cosa rara" en cuyo caso lo corregiría

Con esta forma de trabajar me he ahorrado tener un montón de "dobles declaraciones" y estar poniendo/quitando la adecuada:

Dim xlsApp As Excel.Application
'Dim xlsApp As Object

Truco:¿Como mantengo mi lista de #constantes?
Yo lo tengo en un módulo independiente dónde, en el encabezado, consta la versión del módulo. Cada vez que añado una constante lo registro en el log de cambios y subo el número de versión. El módulo lo exporto a una determinada carpeta. Además llevo un registro de versiones de todos los módulos en un Excel.

Cuando debo actualizar una aplicación, lo primero es revisar las versiones de los módulos por si tuviera versiones más actuales. Si el módulo de directivas de mi archivo es más moderno del de la aplicación, simplemente importo el nuevo módulo.

Espero que os sirva para "salvar" el problema de las referencias.
8
Formularios / Crear menú flotante
« Último mensaje por xavi en Mayo 02, 2020, 05:08:16 pm »
Palabras clave: formulario, menú, API
Autor: Candace Tripp
Extraído de: Utter Access (allá por 2007)

Objetivo:
Crear un menú flotante en el formulario.

Utilizamos un formulario con 3 botones (el ejemplo original utiliza 3 botones transparentes encima de 3 etiquetas pero se puede hacer con botones de fondo transparente)
En el módulo de clase del ejemplo las opciones se definen "a pedal". Se podría trabajar con una tabla que llame a funciones (a estudiar)

El código del formulario es este:

Código: [Seleccionar]
Option Compare Database
Option Explicit

Dim oMenu As cMenu

Private Sub mnuFile_Click()
    oMenu.ShowMenu "File"
End Sub

Private Sub mnuEdit_Click()
    oMenu.ShowMenu "Edit"
End Sub

Private Sub mnuHelp_Click()
    oMenu.ShowMenu "About"
End Sub

Private Sub Form_Load()
   
    Set oMenu = New cMenu
    Set oMenu.CurrentForm = Me

End Sub

Después tenemos un módulo de clase como este:

Código: [Seleccionar]
Option Compare Database
Option Explicit
'######################################################################
'
'CLASSNAME      :   cMenu
'
'PURPOSE        :   Class to emulate a drop down menu using API calls
'
'DATE CREATED   :   2/2/2005
'
'AUTHOR         :   Candace Tripp
'                   http://www.candace-tripp.com/
'
'NOTE           :   This API calls/code is a modification of Bryan Stafford's
'                   popup menu demo project written in Visual Basic 6.
'                   This demo is released into the public domain "as is" without
'                   warranty or guaranty of any kind.  In other words, use at your own risk.
'                   His comments are below
'
'MODIFICATIONS:
'   DATE        MODIFIED BY     MODIFICATION DESCRIPTION
'   ----        -----------     -----------------------------------------
'
'######################################################################

'Bryan Stafford of New Vision Software
'######################################################################
' demo project showing how to use the API menu functions to create a
' popup menu. by Bryan Stafford of New Vision Software - newvision@mvps.org
' this demo is released into the public domain "as is" without warranty or
' guaranty of any kind.  In other words, use at your own risk.


' the handles to our popup menus.  we keep them at the module level so that
' we don't have to recreate the menus each time we want to display them.
'######################################################################
 
    Private m_CurrentForm As Form
    Private m_lngItemWidth As Long
    Private m_lngItemTop As Long
   
    Private m_hMenu(3) As Long
    Private m_hSubMenu(3) As Long
   
    Private Type POINTAPI
        X As Long
        Y As Long
    End Type
   
    Private Const MF_INSERT As Long = &H0&
    Private Const MF_CHANGE As Long = &H80&
    Private Const MF_APPEND As Long = &H100&
    Private Const MF_DELETE As Long = &H200&
    Private Const MF_REMOVE As Long = &H1000&
    Private Const MF_BYCOMMAND As Long = &H0&
    Private Const MF_BYPOSITION As Long = &H400&
    Private Const MF_SEPARATOR As Long = &H800&
    Private Const MF_ENABLED As Long = &H0&
    Private Const MF_GRAYED As Long = &H1&
    Private Const MF_DISABLED As Long = &H2&
    Private Const MF_UNCHECKED As Long = &H0&
    Private Const MF_CHECKED As Long = &H8&
    Private Const MF_USECHECKBITMAPS As Long = &H200&
    Private Const MF_STRING As Long = &H0&
    Private Const MF_BITMAP As Long = &H4&
    Private Const MF_OWNERDRAW As Long = &H100&
    Private Const MF_POPUP As Long = &H10&
    Private Const MF_MENUBARBREAK As Long = &H20&
    Private Const MF_MENUBREAK As Long = &H40&
    Private Const MF_UNHILITE As Long = &H0&
    Private Const MF_HILITE As Long = &H80&
    Private Const MF_SYSMENU As Long = &H2000&
    Private Const MF_HELP As Long = &H4000&
    Private Const MF_MOUSESELECT As Long = &H8000&
   
   
    Private Const TPM_RETURNCMD As Long = &H100&
   
   
    Private Const ID_BEEP As Long = &H6000&
    Private Const ID_SEPARATOR As Long = &H6001&
    Private Const ID_DISABLED As Long = &H6002&
    Private Const ID_MSGBOX As Long = &H6003&
   
    Private Const ID_ADD As Long = &H6004&
    Private Const ID_EDIT As Long = &H6005&
    Private Const ID_DELETE As Long = &H6006&
    Private Const ID_EXIT As Long = &H6007&
    Private Const ID_HELP As Long = &H6008&
   
    Private Declare Function CreatePopupMenu Lib "user32" () As Long
    Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu&) As Long
    Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpNewItem$) As Long
    Private Declare Function ClientToScreen& Lib "user32" (ByVal hwnd&, lpPoint As POINTAPI)
    Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu&, ByVal wFlags&, ByVal X&, ByVal Y&, ByVal nReserved&, ByVal hwnd&, ByVal lpRect&) As Long
    Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu&, ByVal wIDEnableItem&, ByVal wEnable&) As Long
   
'PROPERTIES ###########################################################
Public Property Set CurrentForm(frmCurrent As Form)
    Set m_CurrentForm = frmCurrent
End Property
Public Property Get CurrentForm() As Form
On Error Resume Next
    If IsObject(m_CurrentForm) Then
        Set CurrentForm = m_CurrentForm
    End If
End Property


Public Property Let ItemTop(lngValue As Long)
    m_lngItemTop = lngValue
End Property
Public Property Get ItemTop() As Long
    ItemTop = m_lngItemTop
End Property


Public Property Let ItemWidth(lngValue As Long)
    m_lngItemWidth = lngValue
End Property
Public Property Get ItemWidth() As Long
    ItemWidth = m_lngItemWidth
End Property
'END PROPERTIES #######################################################

'METHODS ##############################################################
Public Sub ShowMenu(strMenuName As String)
    Dim intItem As Integer
    Select Case strMenuName
    Case "File"
        intItem = 0
    Case "Edit"
        intItem = 1
    Case Else '"About"
        intItem = 2
    End Select
   
    DisplayPopupMenu intItem, ItemWidth * intItem, ItemTop
End Sub
'END METHODS ##########################################################

'######################################################################
Private Sub Class_Initialize()
    ' defaults
    m_lngItemWidth = 64
    m_lngItemTop = 19
End Sub

Private Sub Class_Terminate()
On Error Resume Next

    Dim intItem1 As Integer
    Dim intItem2 As Integer
   
    For intItem1 = 0 To UBound(m_hMenu) - 1
        If m_hMenu(intItem1) Then
            Call DestroyMenu(m_hMenu(intItem1))
        End If
    Next intItem1
   
    For intItem2 = 0 To UBound(m_hSubMenu) - 1
        If m_hSubMenu(intItem2) Then
            Call DestroyMenu(m_hSubMenu(intItem2))
        End If
    Next intItem2
End Sub
'######################################################################

'######################################################################
Private Sub DisplayPopupMenu(intItem As Integer, ByVal X&, ByVal Y&)

    Dim pt As POINTAPI
    Dim lngReturn As Long
     
    ' if the menu hasn't already been created, create it....
    If m_hMenu(intItem) = 0 Then
        Select Case intItem
        Case 0 ' File
            m_hMenu(intItem) = CreatePopupMenu()
           
            ' add an item....
            Call AppendMenu(m_hMenu(intItem), MF_STRING, ID_BEEP, ByVal "Sound A ""Beep""")
           
            ' add a separator....
            Call AppendMenu(m_hMenu(intItem), MF_STRING Or MF_SEPARATOR, ID_SEPARATOR, ByVal vbNullString)
           
            ' add another item....
            Call AppendMenu(m_hMenu(intItem), MF_STRING, ID_DISABLED, ByVal "A Disabled Item")
            ' disable the last item we added....
            Call EnableMenuItem(m_hMenu(intItem), ID_DISABLED, MF_BYCOMMAND Or MF_DISABLED Or MF_GRAYED)
           
            ' add the next item....
            Call AppendMenu(m_hMenu(intItem), MF_STRING, ID_MSGBOX, ByVal "Display A MessageBox")
       
            ' add a separator....
            Call AppendMenu(m_hMenu(intItem), MF_STRING Or MF_SEPARATOR, ID_SEPARATOR, ByVal vbNullString)
       
            ' add the last item....
            Call AppendMenu(m_hMenu(intItem), MF_STRING, ID_EXIT, ByVal "Exit")
        Case 1 ' Edit
             ' first create our sub menu....
            m_hSubMenu(intItem) = CreatePopupMenu()
       
            ' add a couple of items to the sub menu....
            Call AppendMenu(m_hSubMenu(intItem), MF_STRING, ID_ADD, ByVal "Add")
            Call AppendMenu(m_hSubMenu(intItem), MF_STRING, ID_EDIT, ByVal "Edit")
            Call AppendMenu(m_hSubMenu(intItem), MF_STRING, ID_DELETE, ByVal "Delete")
           
            m_hMenu(intItem) = CreatePopupMenu()
           
            ' add the item to which we attach the sub menu....
            Call AppendMenu(m_hMenu(intItem), MF_STRING Or MF_POPUP, m_hSubMenu(intItem), ByVal "Edit")
           
        Case Else ' About
           
            m_hMenu(intItem) = CreatePopupMenu()
           
            ' add an item....
            Call AppendMenu(m_hMenu(intItem), MF_STRING, ID_HELP, ByVal "Help")
           
            ' add a separator....
            Call AppendMenu(m_hMenu(intItem), MF_STRING Or MF_SEPARATOR, ID_SEPARATOR, ByVal vbNullString)
           
            ' add the last item....
            Call AppendMenu(m_hMenu(intItem), MF_STRING, ID_MSGBOX, ByVal "About")
        End Select
       
    End If
   
   
    With pt  ' the x & y position where you want the menu displayed
        .X = X
        .Y = Y
       
        ' translate to screen coordinates
        Call ClientToScreen(CurrentForm.hwnd, pt)
       
        ' call the api function to display the menu and check the return value
        lngReturn = TrackPopupMenu(m_hMenu(intItem), TPM_RETURNCMD, .X, .Y, 0&, CurrentForm.hwnd, 0&)
       
        Call MenuAction(lngReturn)
       
    End With
   
End Sub


Private Sub MenuAction(lngReturn As Long)
On Error Resume Next

    Select Case lngReturn
        Case ID_BEEP
            Beep
       
        Case ID_MSGBOX
            MsgBox "Form with Menu created by Candace Tripp" & vbCrLf & "http://www.candace-tripp.com/", vbInformation
       
        Case ID_ADD
            MsgBox "You chose ""Add"".", vbExclamation
       
        Case ID_EDIT
            MsgBox "You chose ""Edit"".", vbExclamation
       
        Case ID_DELETE
            MsgBox "You chose ""Delete"".", vbExclamation
       
        Case ID_HELP
            SendKeys "{F1}"
           
        Case ID_EXIT
            DoCmd.Close acForm, CurrentForm.Name, acSavePrompt
               
        End Select

End Sub
'######################################################################





9
Formularios / Recuperar última posición en formulario
« Último mensaje por xavi en Mayo 02, 2020, 04:43:32 pm »
Palabras clave: guardar, almacenar, recordar, última, posición, registro
Autor: ¿?
Extraído de: Utter Access (allá por 2007)

Objetivo:
La idea es almacenar la última posición del usuario al entrar en un formulario. Sirve para tipo Lista o tipo Ficha. Requiere de varias acciones.

1. Tener una tabla de posiciones (puede ser local ya que es del propio usuario)
2. Las tablas deben tener un campo ID único.
3. En el formulario, asignar una función a todos los controles del registro para el evento "Al recibir enfoque". Esa función almacena en memoria el registro y el campo enfocado.
4. En el evento Close, se almacena:
  - Formulario
  - Id del registro
  - Último campo enfocado
  - Usuario (redundante si es local)
  - Momento
  El almacenado de los datos puede ser acumulativo (nuevo registro por lo que Momento es relevante) o sustitutivo (editar el registro para combinación de formulario-usuario por lo que Momento es irrelevante)

En el momento de abrir el formulario, abrir un recordset o utilizar un Dlookup para recuperar el ID de la combinación formulario-usuario (si es acumulativo, incluir Momento en la "ecuación")
Mediante Bookmarks, posicionar el registro. Algo así:


Código: [Seleccionar]
Private Sub GoToLastSavedPosition()
    Dim strSQL           As String
    Dim rstFormPositions As DAO.Recordset
   
    strSQL = " SELECT Last(tblFormPositions.LastRecordID) AS LastOfLastRecordID," & _
                    " Last(tblFormPositions.LastActiveControl) AS LastOfLastActiveControl," & _
                    " Max(tblFormPositions.LastTimeSaved) AS MaxOfLastTimeSaved" & _
             " FROM tblFormPositions" & _
             " GROUP BY tblFormPositions.FormName," & _
                      " tblFormPositions.LastUser" & _
             " HAVING tblFormPositions.FormName = " & Chr$(34) & Me.Name & Chr$(34) & _
             " AND tblFormPositions.LastUser = " & Chr$(34) & CurrentUser() & Chr$(34)

    Set rstFormPositions = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
   
    With rstFormPositions
        If .RecordCount <> 0 Then
            If !LastOfLastRecordID <> 0 And Not IsNull(!LastOfLastActiveControl) Then
                Me.RecordsetClone.FindFirst "[ID] = " & !LastOfLastRecordID
                Me.Bookmark = Me.RecordsetClone.Bookmark
                Me(!LastOfLastActiveControl).SetFocus
            End If
        End If
        .Close
    End With
   
    Set rstFormPositions = Nothing
   
End Sub
El ejemplo original lanza ese código en el Form_Timer del formulario (Intervalo = 1) con este códig:

Código: [Seleccionar]
Private Sub Form_Timer()
    Static blnFormOpen As Boolean
   
    If Not blnFormOpen Then
        blnFormOpen = True
        Me.TimerInterval = 0
       
        GoToLastSavedPosition
    End If
   
End Sub
10
Consejos, técnicas, artículos / Localizar error. Número de línea
« Último mensaje por xavi en Abril 28, 2020, 01:38:10 pm »
Palabras clave: control errores, línea
Autor: xavi
Extraído de: experiencia

Objetivo:
Localizar la línea del error exacta.

En nuestras aplicaciones a veces es necesario no solo controlar el error y devolver la respuesta adecuada. En algunos casos podemos recibir el "feedback" de un cliente con un error pero no es posible saber cual de las líneas de código ha sido la que ha generado el error.

En desarrollo, dentro de mi control de errores, ya está preparado para que, en caso de error, el código de pare (Stop) y a continuación vaya a la línea del error (Resume). El problema es en el cliente dónde no interesa mostrar ciertas cosas. En ese caso estaría bien poder recuperar la línea del error y que el cliente nos la comunicara.

¿Y cómo se obtiene la línea de error?
Pues ("back to the past") ¡numerando las líneas! y recuperando el número de línea con la propiedad Erl.
Algunos no lo habréis visto nunca y otros no numeran una línea desde que dejaron GWBasic.

¿Y cómo numero las lineas? Porque mi aplicación tiene miles de líneas...
La mejor forma si no quieres dejarte las uñas en el teclado es utilizar una herramienta externa: MZ-Tools

Esa herramienta permite poner y quitar números de línea de forma muy sencilla. El alcance de esa utilidad es el que nosotros queramos: desde un procedimiento hasta un grupo de proyectos.

¿Y cuando hago eso?
Pues yo lo haría justo antes de entregar la aplicación al cliente.

¿Es cómodo trabajar con números de línea puestos?
La verdad es que es un engorro porque cualquier nueva línea deberá tener su número. Lo mejor es quitar todos los números de línea del proyecto cuando se tenga que editar el código, modificar y volver a poner números de línea. Dado que los números de línea sólo sirven para la propiedad Erl, no debería representar un problema (a diferencia del pasado dónde los GoTo se hacían por número de línea).

¿Cómo utilizo Erl?
Muy sencillo. Dentro del control de errores, la propiedad Erl devuelve el número de línea. Si no hay números de línea, devuelve 0.

MsgBox "Error en línea: " & Erl & vbNewLIne & Err.Number & " - " & Err.Description

Dicho todo esto, yo nunca he numerado líneas  8)
Páginas: [1] 2 3 ... 10