** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - Crear tabla y campo double con DAO
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoCrear tabla y campo double con DAO

 Responder Responder
Autor
Mensaje Invertir el orden de clasificación
buho Ver desplegable
Administrador
Administrador
Avatar
Abuelo FELIZ

Unido: 10/Abril/2004
Localización: Valladolid
Estado: Sin conexión
Puntos: 11317
Enlace directo a este mensaje Tema: Crear tabla y campo double con DAO
    Enviado: 10/Agosto/2013 a las 00:34
Bueno...tomando ejemplo de Emilio Wink que tambien ha posteado hoy una nueva utilidad (Eliminar duplicados) aquí va la mía...consecuencia de una respuesta reciente en este foro (Junio de 2006)

Sub Crea_Tabla_Campo_Double_Propiedades(StrTabla As String, _
    StrCampo As String, IntDecimales As Integer, _
    DblValordefecto As Double, StrFormato As String)
  
   '**********************************************************************************************************
   '* Bueno aquí va un ejemplo con DAO (Aprovechando que el Access 2007
   '* vuelve a potenciar esta librería de acceso a datos desde Access)
   '* que tiene el siguiente propósito didáctico:
  
   '* (A) Crear una nueva Tabla en la BD activa
   '* (B) Crear un nuevo campo tipo Double
   '* (C) Especificar alguna de las propiedades de dicho campo Double
   '* Buho, Junio de 2006
   '*  ! VIVA LA DAO 3.6 O SU SUSTITUTA EN ACCESS 2007:
   '*    Microsoft Office 2007 Access Database Engine ACEDAO :-)
   '***********************************************************************************************************
 
 
  
   'Dimensionamos los objetos tipo Object para evitar problemas
   'con las Referencias.
  

   Dim MiDbs As Object 'DAO.Database
   Dim ObjetoTablaNuevo As Object 'DAO.TableDef
   Dim ObjetoCampo As Object ' DAO.Field
   Dim PrP As Object ' DAO.Property
  
   Set MiDbs = CurrentDb
   Set ObjetoTablaNuevo = MiDbs.CreateTableDef(StrTabla)
   With ObjetoTablaNuevo
      .Fields.Append .CreateField(StrCampo, dbDouble)
       MiDbs.TableDefs.Append ObjetoTablaNuevo
   End With
   'Aquí, una vez creada la tabla y el campo me voy y varío
   'sus propiedades. Ojo que a la hora
   'de crear la propiedad de «Decimales» (Y alguna más)
   'hay que tener presente que no es una propiedad por defecto
   'es decir...que la primera vez * HAY QUE CREARLA*
  

   'Asignamos el objeto Field
   Set ObjetoCampo = MiDbs.TableDefs(StrTabla).Fields(StrCampo)
    On Error GoTo Etoqueta_error_Decimales
    ObjetoCampo.Properties("DecimalPlaces") = IntDecimales
    'Para asignar el valor por defecto no es necesario
    'crear la propiedad, se crea directamente al crear la tabla
    'y el campo:

     ObjetoCampo.Properties("DefaultValue") = DblValordefecto
    
     'al crear la tabla y el campo, la primera vez la propiedad Format no
     'existe y hay que crearla:
    

     On Error GoTo Etoqueta_error_Formato
     'aqui creo el campo con formato pasado por el sub según estas constantes:

     'General Number = Numero General
     '#,##0.00 €;-#,##0.00 €= Moneda (Euro)
     'Fixed = Fijo
     'Standard = Estandar
     'Percent = Porcentaje
     'Scientific = Cientifico
     ObjetoCampo.Properties("Format") = StrFormato
     Set ObjetoTablaNuevo = Nothing
     MiDbs.Close
     Set MiDbs = Nothing
  
Etoqueta_error_Decimales:
    If Err.Number = 3270 Then 'Propiedad no existente aún...se crea:
        Set PrP = ObjetoCampo.CreateProperty()
            With PrP
                .Name = "DecimalPlaces"
                .Type = dbByte
                .Value = IntDecimales
            End With
            ObjetoCampo.Properties.Append PrP
            Resume Next
    End If
  
Etoqueta_error_Formato:
    If Err.Number = 3270 Then 'Propiedad no existente aún...se crea:
        Set PrP = ObjetoCampo.CreateProperty()
            With PrP
                .Name = "Format"
                .Type = dbText
                .Value = StrFormato
            End With
            ObjetoCampo.Properties.Append PrP
            Resume Next
    End If
End Sub


Sub ProbandoProcedimiento()
'Esto es para probar el procedimiento anterior y ver como funciona:
Crea_Tabla_Campo_Double_Propiedades "MitablaPruebas", "MicampoDoble", _
    2, 12.34, "General Number"
End Sub
Expulsado de la cárcel por robar los barrotes
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable