Palabras clave: Enumeraciones
Autor: Gustav Brock
Extraído de: Experiencia propia

Hace ya muchos años que utilizo las enumeraciones para distintas cosas.

Imaginemos esta enumeración


Public Enum eGestorCorreo
    NotDefined = 0
    Outlook
    Notes
    Firefox
End Enum


En un determinado momento me fue necesario saber cuál era el valor máximo de una enumeración y la solución que propuso Chea fue agregar un nuevo elemento llamado, por ejemplo, EnumMax que daria el valor siguiente al último.


Public Enum eGestorCorreo
    NotDefined = 0
    Outlook
    Notes
    Firefox
    EnumMax
End Enum


El problemilla (es más un TOC que un problema) es que ese valor de EnumMax aparece en el Intellisense. Pues resulta que se puede ocultar anteponiendo el guion bajo al nombre _EnumMax y  envolviéndolo todo entre corchetes (un nombre que empieza con _ produce error) de manera que quede oculto en el Intellisense.


Public Enum eGestorCorreo
    NotDefined = 0
    Outlook
    Notes
    Firefox
    [_EnumMax]
End Enum



Cada día se aprende algo

Palabras clave: redondear, arriba
Autor: Experiencia propia

Necesito emular el funcionamiento de MULTIPLO.SUPERIOR.MAT de Excel en Access. Dado que no encuentro una función o comando que lo haga, me creo una pequeña función:



Function RedondeaArriba(dblNumero As Double) As Long
    ' Función que toma un número con decimales y lo devuelve sin decimales como Long
   
    RedondeaArriba = Int(dblNumero) + Abs(dblNumero > Int(dblNumero))

End Function



Por necesidades "x" se requiere introducir un registro en una determinada posición de una tabla con un determinado valor en el campo autonumérico. No existe una forma sencilla de hacerlo así que debemos tirar de astucia.

Happy nos enseña un par de funciones que, bien colocadas en otro procedimiento, pueden obtener el resultado esperado.

Yo creo que hay que hacerlo en 3 pasos:

GetSeed para saber el próximo autonumérico (y guardarlo para el paso 3)
SetSeed para establecer el siguiente registro
(insertar el registro)
SetSeed con el valor guardado en paso 1


Obtener el siguiente autonumérico

Public Function GetSeed(Tabla As String, Campo As String) As Long
Dim cat As Object
   
    On Error Resume Next
    Set cat = CreateObject("ADOX.Catalog")
    ' para otra base de datos externa a la actual
    ' sustituir CurrentProject.Connection por objecto ADODB.Connection ADODB
    ' conectado a la base externa
    cat.ActiveConnection = CurrentProject.Connection
    GetSeed = cat.Tables(Tabla).columns(Campo).Properties("Seed")
    Set cat = Nothing
    On Error GoTo 0
   
End Function


Establecer el siguiente autonumérico

Public Function SetSeed(Tabla As String, _
                        Campo As String, _
                        SiguienteNumero As Long, _
                        Optional Intervalo As Long) As Boolean
Dim cat As Object
   
    On Error Resume Next
    Set cat = CreateObject("ADOX.Catalog")
    ' para otra base de datos externa a la actual
    ' sustituir CurrentProject.Connection por objecto ADODB.Connection ADODB
    ' conectado a la base externa
    cat.ActiveConnection = CurrentProject.Connection
    cat.Tables(Tabla).columns(Campo).Properties("Seed") = SiguienteNumero
    If Intervalo <> 0 Then
        cat.Tables(Tabla).columns(Campo).Properties("Interval") = Intervalo
    End If
    Set cat = Nothing
    On Error GoTo 0

End Function


Esta página no admite preguntas. Para ello referirse a www.mvp-access.com y presentar la duda allí.

** ¿Qué pasaría si, en lugar de referenciar objetos o datos, simplemente los duplicamos en cada lugar donde se necesiten? ¿Sería una locura total o una solución ingeniosa para evitar problemas de sincronización y dependencias? ¿O acaso estamos subestimando el caos que esto podría generar en un sistema complejo?

Palabras clave: correo, firma
Autor: acilu55
Extraído de: MV-Access

---

REDACCION PROVISIONAL


Objetivo
Se preguntó como enviar mail con firma. En principio era con CDO (que desconocía que se podía hacer) y acilu55 propuso, mediante Outlook, la capacidad de utilizar una plantilla de mail con la firma:


Set OUTAPP = CreateObject("Outlook.Application")
Set OUTMAIL = OUTAPP.CreateItemFromTemplate(Application.CurrentProject.Path & "\oficio.oft")
' oficio.oft es una plantila de mail con la firma
With OUTMAIL
.To = mail
.cc = ""
.bcc = ""
.BodyFormat = olFormatHTML
           
.Subject = "asunto del envio"
adjunto1 = Application.CurrentProject.Path & "\factura.pdf"

.Attachments.Add (adjunto1)


Palabras clave: entorno, environ, variables
Autor: Sergio Alejandro Campos
Extraído de: EXCELeINFO



La necesidad surge al necesitar saber si existe una variable de entorno que devuelva el nombre del usuario "bonito" (que no existe) y no saber las posibles variables que se pueden consultar.

Sergio nos brinda este código (requiere un libro con una "Hoja1" y habilitado para macros



Sub MostrarVariables()
    'Declaramos variables
    '
    Dim i As Integer
    '
    i = 1
    '
    'Mientras el valor de Environ NO sea vacío, se obtiene el valor.
    While Environ(i) <> Empty
        '
        ActiveWorkbook.Sheets("Hoja1").Range("A8").Offset(i, 0).Value = Environ(i)
        '
        i = i + 1
        '
    Wend
    '
End Sub


Actualización tomando la info de Allen Browne Hay un ejemplo en esa URL

Para evitar problemas, utiliza una colección pública y un código en un módulo independiente.
El ejemplo de Allen toma un formulario llamado frmClient


Public clnClient As New Collection    'Instances of frmClient.
Function OpenAClient()
    'Purpose:    Open an independent instance of form frmClient.
    Dim frm As Form

    'Open a new instance, show it, and set a caption.
    Set frm = New Form_frmClient
    frm.Visible = True
    frm.Caption = frm.Hwnd & ", opened " & Now()

    'Append it to our collection.
    clnClient.Add Item:=frm, Key:=CStr(frm.Hwnd)

    Set frm = Nothing
End Function

Function CloseAllClients()
    'Purpose: Close all instances in the clnClient collection.
    'Note: Leaves the copy opened directly from database window/nav pane.
    Dim lngKt As Long
    Dim lngI As Long

    lngKt = clnClient.Count
    For lngI = 1 To lngKt
        clnClient.Remove 1
    Next
End Function


La segunda función CloseAllClients() muestra cómo cerrar estas instancias eliminándolas de nuestra colección. Pero si el usuario cierra una instancia con la interfaz normal, debemos eliminar esa instancia de nuestra colección. Eso se hace en el evento Cerrar del formulario frmClient de esta manera:


Private Sub Form_Close()
    'Purpose: Remove this instance from clnClient collection.
    Dim obj As Object        'Object in clnClient

    Dim blnRemove As Boolean  'Flag to remove it.

    'Check if this instance is in the collection.
    For Each obj In clnClient
        If obj.Hwnd = Me.Hwnd Then
            blnRemove = True
            Exit For
        End If
    Next

    'Deassign the object and remove from collection.
    Set obj = Nothing
    If blnRemove Then
        clnClient.Remove CStr(Me.Hwnd)
    End If
End Sub


Palabras clave: ejecutar, elemento, menú, commandbars, executemso
Autor: De aquí y de allá., pero la clave la dá René Nyffenegger
URL:Microsoft Learn
URL:René Nyffenegger
URL:github (también accesible desde URL anterior)


Objetivo
En ocasiones hay que ejecutar acciones de menú que no están accesibles mediante otros comandos de VBA. Para ello podemos invocar el método Application.CommandBars.ExecuteMso(idMSO)
El problema está en localizar los idMSO ya que la página de Microsoft es muy parca.
En la página de René se enlaza un repositorio de GitHub dónde se puede acceder a varias carpetas para distintas versiones de Office y, dentro de cada una, a una serie de ficheros Excel con todas las colecciones de idMSO

Palabras clave: fecha, laborable, dia.lab.intl
Autor: xavi

---

Necesidad
Obtener que día será una fecha dada una fecha inicial, un número de laborales, un tipo de semana laboral y la utilización de una tabla de festivos.

Es una emulación (con ligeros cambios) de la función DIA.LAB.INTL de Excel

Function DiaLabIntl(dtmFechaInicial As Date, intDiasProceso As Integer, Optional strTipoSemanaLaboral As String = "0000011", Optional blnAplicaFestivos As Boolean = True) As Date
    ' Función análoga a la de Excel utilizando el tipo de semana laboral como cadena y un boolean para aplicar laborables y festivos
    ' En caso de aplicar festivos será necesario indicar el nombre de la tabla y el campo de la tabla que contiene la fecha
   
    ' La cadena de strTipoSemanaLaboral se establece con 7 ceros y unos. El cero indica laborable y el uno festivo.
    ' Así, "0000011" indica el fin de semana de sábado-domingo. Esa técnica nos permite gestionar (casi) cualquier combinación
   
   
    Const cTablaFestivos As String = "tblDatFestivos"
    Const cCampoFecha As String = "FechaFestiva"
   
    Dim dtmLaFecha  As Date
    Dim intdias As Integer
   
    ' Establecemos la fecha inicial
    dtmLaFecha = dtmFechaInicial
   
    ' Bucle sin condiciones
    Do
        ' Evaluamos si el día de la semana se ha estipulado como festivo.
        If Mid(strTipoSemanaLaboral, Weekday(dtmLaFecha, vbMonday), 1) = "1" Then
            ' Es un NO-laborable: no hacemos nada
        Else
            ' En este punto "parece" un laborable pero miramos si es festivo (si procede)
            If blnAplicaFestivos And DCount("*", cTablaFestivos, cCampoFecha & "= " & CLng(dtmLaFecha)) > 0 Then
                ' es un festivo: nada
            Else
                ' Ni es fin de semana, ni es festivo (sea porque no aplica, sea porque no lo es)
                intdias = intdias + 1
            End If
        End If
       
        ' Comprobamos si hemos alcanzado el limite de días
        If intdias >= intDiasProceso Then
            DiaLabIntl = dtmLaFecha
            Exit Function
        End If
        ' Aumentamos un día
        dtmLaFecha = DateAdd("d", 1, dtmLaFecha)
        ' Comprobación de seguridad
        If dtmLaFecha > DateAdd("d", intDiasProceso + 1000, dtmFechaInicial) Then
            MsgBox "Creo que nos hemos pasado de largo", vbExclamation
            DiaLabIntl = "01/01/1900"
            Exit Function
        End If
    Loop

End Function