Noticias:

Reinstalando todo...

Menú Principal

Mensajes recientes

#61
Excel / Esconder ventana Excel tras Us...
Último mensaje por xavi - Abril 01, 2020, 05:35:11 PM
Palabras clave: Excel, UserForm, ventana, esconder, ocultar
Autor: Xavi
Extraído de: Experiencia propia

Por exigencia de un cliente, la ventana de Excel no habría de visualizarse dejando únicamente el UserForm. Un truco para ello es ajustar la ventana al tamaño del UserForm (bueno, un poquito menos) y controlar el movimiento del formulario para mover la ventana detrás

Al abrir el Libro de Excel, forzar el estado de la ventana de Excel a normal. Evento Workbook_Open, por ejemplo.

ActiveWindow.WindowState = xlNormal

Después, en cada UserForm, para el evento Layout, redimensionamos la ventana

Private Sub UserForm_Layout()
    With ActiveWindow
        .Top = Me.Top + 5
        .Left = Me.Left + 10
        .Height = Me.Height - 30
        .Width = Me.Width - 30
    End With
End Sub


#62
Consultas / Re:MULTISELECT
Último mensaje por xavi - Abril 01, 2020, 05:09:33 PM
Hola,

Las dudas en www.mvp-access.com

Gracias
#63
Base de datos / Re:¿Cómo ocultar la ventana de...
Último mensaje por xavi - Abril 01, 2020, 05:09:17 PM
Hola,

Las dudas en www.mvp-access.com

Gracias
#64
API / InputBox extendido
Último mensaje por xavi - Marzo 31, 2020, 12:21:55 AM
Palabras clave: inputbox, extendido, inputboxex, limitar, caracteres, API
Autor: Happy / Abril 2004
Extraído de: Access y VBA

Objetivo:
Rescato este módulo de Happy de abril de 2004 (suministrado por javier.mil ya que yo no lo encontraba) para añadir funcionalidad a un InputBox. El propio módulo incluye los comentarios del autor.

En un módulo independiente:

Option Compare Database
Option Explicit

'******************************************************
'
' InputBoxEx
'
' Función que amplía el InputBox de VBA, confiriéndole
' diferentes estilos (contenidos en la enumeración
' StyleInputBox). También, en su último argumento (MaxChar)
' podemos limitar el número de caracteres que se podrán
' introducir.
'
' Uso:
'
'   Function InputBoxEx( _
'            Prompt, _      véase en la ayuda InputBox
'            [Title], _             "       "
'            [Default], _           "       "
'            [XPos], _              "       "
'            [YPos], _              "       "
'            [HelpFile], _          "       "
'            [Context] _            "       "
'            [Style] _ ------> cualquiera de los valores de la enumeración StyleInputBox
'            [MaxChar])------> si su valor es diferente de 0 marca el límite de
'                              caracteres admitidos por el InputBox
'
' Ejemplo: (muestra un InputBox para introducir contraseñas, con el límite de
'           10 caracteres)
'
'  Contraseña = InputBoxEx("Mensaje", "Titulo", , , , , , SPassword, 10)'
' Autor: Juan M. Afan de Ribera
'        Abril 2004
'
' Saludos :-)
' happy
'*********************************************************************

' estilos del InputBoxEx
Public Enum StyleInputBox
    SNone       ' InputBox normal
    SPassword   ' máscara oculta
    SNumber     ' sólo números
    SLowerCase  ' sólo minúsculas
    SUpperCase  ' sólo mayúsculas
End Enum

Private Declare Function FindWindowEx Lib "user32" _
                Alias "FindWindowExA" _
                (ByVal hWnd1 As Long, _
                ByVal hWnd2 As Long, _
                ByVal lpsz1 As String, _
                ByVal lpsz2 As String) As Long
               
Private Declare Function SendMessage Lib "user32" _
                Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
                (ByVal hwnd As Long, _
                ByVal nIndex As Long) As Long
               
Private Declare Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
                (ByVal hwnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long
               
Private Declare Function SetTimer Lib "user32" _
                (ByVal hwnd As Long, _
                ByVal nIDEvent As Long, _
                ByVal uElapse As Long, _
                ByVal lpTimerFunc As Long) As Long
               
Private Declare Function KillTimer Lib "user32" _
                (ByVal hwnd As Long, _
                ByVal nIDEvent As Long) As Long

Private Const GWL_STYLE = (-16)

' constantes con los estilos de
' controles 'EDIT'
Private Const ES_UPPERCASE = &H8
Private Const ES_LOWERCASE = &H10
Private Const ES_PASSWORD = &H20
Private Const ES_NUMBER = &H2000

' mensaje para establecer el caracter que se mostrará
' como máscara para el InputBoxEx tipo contraseña
Private Const EM_SETPASSWORDCHAR = &HCC
' constante que contiene el carácter que se mostrará
' (este valor puede ser cualquier otro, en este caso
' he escogido el típico asterisco)
Private Const KEY_MASK = 42& ' "*"
' mensaje para establecer el número máximo de
' caracteres permitidos
Private Const EM_LIMITTEXT = &HC5

Private SInputBox As StyleInputBox
Private hInputBox As Long
Private cChar As Long

Public Function InputBoxEx( _
                Prompt, _
                Optional Title, _
                Optional Default, _
                Optional XPos, _
                Optional YPos, _
                Optional HelpFile, _
                Optional Context, _
                Optional Style As StyleInputBox = SNone, _
                Optional MaxChar As Long) As String
             
    ' si no hay ningún otro InputBoxEx abierto...
    If hInputBox = 0 Then
       ' Creamos un timer que se ejecutará a la décima de segundo
       Call SetTimer(Access.hWndAccessApp, 0&, 100, AddressOf TimerProc)
   
       SInputBox = Style
       cChar = MaxChar
       ' llamamos al InputBox de manera normal
       On Error GoTo AnularTimer
       InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    End If
   
    Exit Function
   
AnularTimer:
    ' si ha habido algún error, se cancela la operación
    Call KillTimer(Access.hWndAccessApp, 0&)
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
   
End Function

Private Sub TimerProc( _
                     ByVal hwnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal idEvent As Long, _
                     ByVal dwTime As Long)
Dim hEdit As Long
Dim CurStyle As Long
   
    ' localizamos el manipulador de la ventana activa
    ' (se supone que es la ventana del InputBox)
    hInputBox = GetForegroundWindow
    ' localizamos el manipulador de la caja de texto
    ' del InputBox
    hEdit = FindWindowEx(hInputBox, 0&, "EDIT", vbNullString)
   
    ' obtenemos los estilos de la caja de texto ...
    CurStyle = GetWindowLong(hEdit, GWL_STYLE)
   
    Select Case SInputBox
        Case SPassword ' tipo password
            ' le decimos a la caja de texto cuál será el carácter
            ' que aparecerá en vez de lo que teclee el usuario
            Call SendMessage(hEdit, EM_SETPASSWORDCHAR, KEY_MASK, 0&)
            ' y le añadimos el estilo de introducción de contraseñas
            CurStyle = CurStyle Or ES_PASSWORD
        Case SNumber ' tipo número
            CurStyle = CurStyle Or ES_NUMBER
        Case SLowerCase ' tipo minúsculas
            CurStyle = CurStyle Or ES_LOWERCASE
        Case SUpperCase ' tipo mayúsculas
            CurStyle = CurStyle Or ES_UPPERCASE
    End Select
   
    If cChar > 0 Then
        Call SendMessage(hEdit, EM_LIMITTEXT, cChar, 0&)
    End If
    ' cambiamos el estilo
    Call SetWindowLong(hEdit, GWL_STYLE, CurStyle)
    ' desactivamos el timer para que sólo se ejecute esta vez
    Call KillTimer(Access.hWndAccessApp, 0&)
    hInputBox = 0
   
End Sub


#65
Base de datos / ¿Cómo ocultar la ventana de Ac...
Último mensaje por cesar_c - Marzo 10, 2020, 02:49:52 AM
Hola,
vi en un post de este foro que indica que esta pregunta es recurrente, sin embargo no logro encontrar el hilo adecuado (disculpen por ello), por lo que formulo mis preguntas:

1. ¿Cómo ocultar la venta de Access para que el archivo funcione como un programa ejecutable de cara al usuario?
De este video (https://www.youtube.com/watch?v=FKx4ZYmDPIw)he cogido un código para ocultar la ventana de Access. 
El código funciona, sin embargo, no entiendo qué significan esas líneas de código, ni dónde aprender respecto a ellas.  Por tanto no puedo manipularlas ni adecuarlas a mis necesidades.
Te agradecería si puedes explicar estas líneas, o, en todo caso, indicar el código que sugieres para hacer ello (y explicarlos de ser posible). (O indicar los hilos donde se trate el tema o las palabras clave para buscarlos)
- ¿qué son esas constantes SW_HIDE, SW_NORMAL, etc.?
- ¿qué es y qué hace esa función ShowWindow Lib "user32" y sus parámetros?
- ¿cómo funciona ShowWindow y sus parámetros?
Entiendo el evento OPEN, pero no entiendo el evento UNLOAD
Lo único que entiendo es la sentencia DoCmd.OpenForm "MENU"   :(


2. ¿Cómo ocultar el botón "[X] (cerrar ventana)" en dicho código?
Sucede que, aunque el código indicado funciona, si por error cierro el formulario con el botón [X], el Access se queda colgado y se tiene que reiniciar la PC.  Agradecería saber cómo incrustar el código para eliminar ese botón (y la explicación del caso).

El código que estoy utilizando es el siguiente:

Option Explicit
Const SW_HIDE = 0
Const SW_NORMAL = 1
Const SW_MINIMIZED = 2
Const SW_MAXIMIZED = 3
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Sub Form_Open(Cancel As Integer)
Call ShowWindow(hWndAccessApp, SW_HIDE)
DoCmd.OpenForm "MENU", windowmode:=acDialog
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim lngRetCode As Long
lngRetCode = ShowWindow(hWndAccessApp, SW_MAXIMIZED)
End Sub


Desde ya muchas gracias por tu atención a estas dudas.
Gracias!

César C.

#66
Varias / Abrir explorador en carpeta
Último mensaje por xavi - Marzo 06, 2020, 01:18:45 AM
Palabras clave: explorador, ficheros, archivos
Autor: miguel
Extraído de: La web del programador

En ocasiones, después de generar más de un fichero por algún procedimiento, necesito mostrar el explorador con los ficheros generados.

Esta función, pasando como argumento la carpeta, la muestra.



Public Sub eRoot(rootpath As String)
    On Error Resume Next
    Dim EX, ARGU, path, X
    EX = "explorer.exe"
    ARGU = " /e,/root, "
    path = rootpath$
    X = Shell(EX & ARGU & path, 1)
End Sub


#67
Base de datos / Crear tabla en base de datos e...
Último mensaje por xavi - Marzo 04, 2020, 11:21:13 PM
Palabras clave: base de datos externa, crear tabla
Autor: Xavi
Extraído de: Experiencia propia y Ayuda de Microsoft

¿Como crear una tabla en una base de datos externa?

Yo manejo dos métodos

Opción 1: tener la tabla previamente creada en el FrontEnd
Con TransferDatabase de exportación y después de linkado, solucionado

Opción 2.1: conectar al backend y crear la tabla por SQL  mediante DoCmd.RunSQL

(obviando declaraciones)
Set app = CreateObject("Access.Application")
app.OpenCurrentDatabase "RutaCompleta"
app.DoCmd.RunSQL "CREATE TABLE nombretabla (campo1 CHAR, campo2 CHAR, campo3 CHAR, campo4 CHAR, campo5 CHAR)
app.CloseCurrentDatabase
Set app = Nothing
(y después vincular con TransferDatabase)

Opción 2.1: conectar al backend y crear la tabla por SQL mediante Execute

(obviando declaraciones)
Set dbs = OpenDatabase("rutacompleta")
dbs.Execute "CREATE TABLE nombretabla (campo1 CHAR, campo2 CHAR, campo3 CHAR, campo4 CHAR, campo5 CHAR)", dbFailOnError
dbs.Close
(y después vincular con TransferDatabase)


#68
Consultas / MULTISELECT
Último mensaje por aramallo - Marzo 04, 2020, 07:26:45 PM
BUen dia para todos: Estoy tratando de generar una consulta con varios nombres de ciudades, para ello diseñe un cuadro de texto donde voy cargando las ciudades y agregandole "o", pero en el momento de generar la consulta no muestra nada.
el cuadro de texto se llama myselectios,y en la consulta queda así
Recortar([Formularios]![GENERADOR-INFORMES]![myselections])
en el adjunto esta el print de pantalla del listbox y el cuadro de texto donde voy viendo las selecciones
me podrian asistir , muchas gracias
Saludos desde Buenos Aires
Abelardo
aqui va el enlace al print de pantalla: https://drive.google.com/open?id=1fgYz8AK05OrIgqQja2Yrtjek77sloJMB

#69
Fechas / Semana Santa y Pascua
Último mensaje por xavi - Febrero 01, 2020, 12:58:14 PM
Palabras clave: calcular, obtener, averiguar, saber, semana santa, pascua, domingo
Autor: GalileoGali
Extraído de: EXCELGALI


Pregunta
¿Como calcular el domingo de pascua y, por extensión, la semana santa?

Buscando en la web se encuentra este link con una función en Excel para calcular el domingo de pascua. La modificación de esa función sería así:


Function DomingoPascua(intAño As Integer) As Date
    On Error GoTo ErrorHandler
   
    ' De: http://excelgali.foroactivo.com/t155-calcular-semana-santa-y-pascua
   
    Dim b, c, d, e, f, g
   
    b = intAño - 1900
    c = b Mod 19
    d = Int((7 * c + 1) / 19)
    e = (11 * c - d + 4) Mod 29
    f = Int(b / 4)
    g = (b + f - e + 31) Mod 7
    DomingoPascua = DateSerial(intAño, 3, 31) + (25 - g - e)

ExitProcedure:
    On Error GoTo 0
    Exit Function
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitProcedure
End Function


#70
WSH / Crear carpetas (sin recursivid...
Último mensaje por xavi - Enero 22, 2020, 12:47:34 AM
Palabras clave: crear, carpeta, directorio, ruta, WSH
Autor: theDBguy's
Extraído de: theDBguy's Access Blog

Dice DBguy:
Todos sabemos que podemos usar la función VBA MkDiR() para crear una carpeta o el método CreateFolder del File System Object (FSO) para hacer lo mismo. Sin embargo, ambos métodos sufren el mismo problema; es decir, solo pueden crear una carpeta de un nivel a la vez. Por ejemplo, el uso de MkDir ("C:\MyNewFolder") creará una carpeta llamada "MyNewFolder" en la carpeta raíz de la unidad C:. Al emitir el siguiente comando: MkDir ("C:\MyOtherFolder\MySubFolder") obtendrá un error de tiempo de ejecución "76: Ruta no encontrada" si C:\MyOtherFolder aún no existe.

Como resultado, la mayoría de los artículos sobre la copia de una estructura de carpetas utilizan un enfoque recursivo en el que el procedimiento recorre el árbol de directorios, un nivel a la vez, creando cada rama en su camino hacia el final. Entonces, en el ejemplo anterior, una función recursiva podría primero verificar si C:\MyOtherFolder existe y crearla si es necesario. Luego, bajará y verificará la existencia de la carpeta MySubFolder y luego la creará según sea necesario. Los métodos VBA y FSO se pueden usar en este enfoque recursivo.

Código ( Adaptado por Xavi) [Seleccionar]

Function CreateFullPath(strTargetFolder As String)
    Dim ws As Object
    Set ws = CreateObject("WScript.Shell")
    ws.Run "cmd /c mkdir """ & strTargetFolder & """"
End Function