Logo_Access_global_380x114Favicon_Access_global_180x180Logo_Access_global_380x114Logo_Access_global_380x114
  • Home
  • University
    • Destellos formativos
  • Labs
  • TV
  • Secciones
    • El mundo de Access
    • Explorando VBA
      • Artículos sobre VBA
      • Un trocito de código
    • Entrevistas
      • Profesionales de Access
    • El rincón de Excel
    • Bases de datos
      • MS SQL
      • MySQL
      • postgreSQL
      • SQLite
    • Clases magistrales
    • Utilidades hechas con Access
  • Access en el mundo
  • ¿Quiénes somos?
  • Cómo colaborar
  • Eventos
✕
            No hay resultados Mostrar todos los resultados
            Access: abrir maximizado
            11/02/2022
            Diseño: efectos en formularios
            13/02/2022
            Mostrar todos

            Access: minicalendario

            Publicado por Antonio Otero
            Categorías
            • Destellos formativos
            Etiquetas
            • Access
            • minicalendario
            'Poner este código en el form del minicalendario
            ' Formulario Calendario_mini
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            ' Fuente            : https://access-global.net/access-minicalendario/
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            ' Título            : Calendario_mini
            ' Autor original    : Antonio Otero
            ' Fecha             : febrero 22
            ' Propósito         : disponer de todos los elementos y funciones necesarias para la creación de un minicalendario
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            
            Private Sub CB_ANO_AfterUpdate()
                
                OBTENER_DIAS
            
            End Sub
            
            Function OBTENER_DIAS()
                Dim an As Integer
                Dim mesv As Integer
                Dim primerdia As Date
                Dim lngdiasmes As String
                Dim lngprimerdia As String
                Dim m As Integer
                Dim dini As Integer
                Dim dfin As Integer
                Dim d As Integer
                Dim ff As Date
                Dim dias As Integer
                Dim filb As String
                Dim ex As Variant
                
                an = Me.CB_ANO
                mesv = Me.ETNMES.Caption
                
                 primerdia = DateSerial(an, mesv, 1)
                 lngdiasmes = Day(DateSerial(an, mesv + 1, 1) - 1)
                 lngprimerdia = DatePart("w", primerdia, vbMonday)
            
               
                For m = 1 To 42
                        Me.Controls("D" & m).Visible = False
                        Me.Controls("d" & m).BackColor = vbWhite
                        Me.Controls("d" & m).Value = 0
                Next m
                dini = lngprimerdia: dfin = dini + (lngdiasmes - 1)
                
                d = 0
                For m = dini To dfin
                        d = d + 1
                        Me.Controls("D" & m).Visible = True
                        Me.Controls("d" & m).Caption = d
                        ff = Format(Format(d, "00") & "/" & Format(mesv, "00") & "/" & an, "mm/dd/yyyy")
                        dias = Weekday(ff)
                        If dias = 1 Then Me.Controls("d" & m).BackColor = vbBlue
                        ex = DLookup("fecha", "public_festivos", "fecha = #" & ff & "#")
                        If Not IsNull(ex) Then Me.Controls("d" & m).BackColor = vbRed
                Next m
                        
            End Function
            
            Private Sub cb_mes_AfterUpdate()
                Dim mex  As Variant
                
                
                Dim n As Integer
                
                mex = Array("", "Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
                For n = 1 To 12
                    If Me.cb_mes = mex(n) Then Me.ETNMES.Caption = n
                Next n
                OBTENER_DIAS
                
            End Sub
            
            Private Function pulsarb()
                    Dim ncon As String, fpul As String
                    Dim colo As Double, ncolo As Double
                    Dim diap As Integer
                    Dim ff As Date
                    
                    
                     ncon = Me.ActiveControl.Name
                     colo = Me.Controls("" & ncon & "").BackColor
                     diap = Me.Controls("" & ncon & "").Caption
                     If colo = 16711680 Or colo = 255 Then ncolo = 16711680: Me.Controls("" & ncon & "").Value = 0
                    
                    fpul = Format(diap, "00") & "/"
                    ff = Format(diap, "00") & "/" & Format(Me.ETNMES.Caption, "00") & "/" & Me.CB_ANO
                    Me.tx_fecha = Format(ff, "dddd, dd  mmmm , yyyy")
                    If colo = 16777215 Then colo = vbBlack
                    Me.tx_fecha.ForeColor = colo
            End Function
            
            Private Sub D7_Click()
            
            End Sub
            
            Private Sub Form_Open(Cancel As Integer)
                If IsNull(Me.CB_ANO) Then Me.CB_ANO = Year(Date)
                If IsNull(Me.cb_mes) Then Me.cb_mes = Format(Date, "mmmm")
                cb_mes_AfterUpdate
                    
            End Sub
            

            Icono

            Minicalendario

            1 archivo(s) 448.20 KB
            ¡Descarga el ejemplo!

            Ver en el repositorio
            Compartir
            24
            Antonio Otero
            Antonio Otero

            Entradas relacionadas

            30/03/2023

            Tratamiento de errores: compilación condicional


            Leer más
            29/03/2023

            Tratamiento de errores: errores personalizados


            Leer más
            28/03/2023

            Tratamiento de errores: Resume


            Leer más

            Deja una respuesta Cancelar la respuesta

            Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

            ETIQUETAS

            Access API BD Botones ComboBox Consultas CountOfLines CStr Diseño DoCmd Excel Exportar Fecha FileSystemObject Filtros For Each...Next Formulario Formularios Funciones Funciones de dominio GetFolder GetWindowRect Google maps Informes InStr Kill Left Listbox Mid Módulos Node ProcCountLines Procedimientos ProcOfLine References Replace Ribbon RunCommand Seguridad Split SysCmd Tablas TreeView VBA VBIDE

            ÚLTIMAS ENTRADAS

            • 0
              Tratamiento de errores: compilación condicional
              30/03/2023
            • 0
              Tratamiento de errores: errores personalizados
              29/03/2023

            ¿QUIERES PUBLICITAR TU EMPRESA AQUÍ?

            SUSCRÍBETE A NUESTRO
            NEWSLETTER

            Recibirás información puntual sobre el mundo de Access y VBA

            ¡Próximamente!

            Promovemos el uso de Access y de la programación en VBA en todo el mundo

            Centro de conocimiento


            Toda la sabiduría de los mejores programadores de Access y VBA a tu alcance.

            Legal

            Política de privacidad

            Condiciones de uso

            Condiciones del redactor

            ®Access Global 2021 | All right reserved
                      No hay resultados Mostrar todos los resultados