Access y VBA
Blog de Access y VBA del Buho


Inicio


Acerca de
Suscríbete al blog

Categorías
General [3] Sindicar categoría
Access con Codigo VBA [15] Sindicar categoría

Archivos
Septiembre 2005 [11]
Agosto 2005 [5]
Junio 2005 [2]

Sindicación (RSS)
Artículos
Comentarios

 


Access con Codigo VBA

Articulos de Access donde esté imerso el código

Anular Tecla Shift

Mediante el siguiente código se puede eliminar las entradas indeseadas con la tecla shift.

si no se entra con la clave indicada, se anula la entrada con la tecla shift, y entrando con la clave se activa para la próxima vez que se entre.

Public Function AlterarPropriedade(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer

  Dim dbs As Database, prp As Property 
  Const conPropNotFoundError = 3270 
  Set dbs = CurrentDb

  On Error GoTo Change_Err

  dbs.Properties(strPropName) = varPropValue 
  AlterarPropriedade = True

Change_Bye: 
  Exit Function

Change_Err:

  If Err = conPropNotFoundError Then ' Propiedad no ha sido localizada. 
    Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue) 

    dbs.Properties.Append prp 
    Resume Next 
  Else 
    ' Error desconocido. 
    AlterarPropriedade = False 
    Resume Change_Bye 
  End If

End Function

Private Sub Form_Open(Cancel As Integer) 
  Dim f As Date 
  Dim hoy As Date 
  Dim usr As String

  usr = InputBox("Introduzca el nombre de usuario", "Usuario", "Pepito de los Palotes")  

  If usr <> "*** MI CLAVE SECRETA ***" Then 
    AlterarPropriedade "AllowBypassKey", dbBoolean, False 
  Else 
    AlterarPropriedade "AllowBypassKey", dbBoolean, True 
  End If 

  

  DoCmd.Close acForm, "inicio"

End Sub

Por ErBuho - 5 de Septiembre, 2005, 1:30, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Comprobar si una matriz está vacía

Emilio Sancha.
Esto, seguro que es una tontería, pero me ha dado mucha guerra, hasta que se me ocurrío controlar el error.

El caso es que cuando intentas mirar el tamaño de una matriz, si esta está vacia, da un error y el proceso casca, en un principio al rellenar la matriz, de paso rellenaba una variable booleana para saber si la matriz estaba o no vacía, ahora uso esta función y ya no necesito más.

'****************************************
'* MatrizVacia
'*devuelve Verdadero/Falso si la matriz pasada como argumento esté vacía o no
'* Argumentos: vntMatriz
'* uso: If MatrizVacia(vntMatriz) then
'* ESH 21/09/04 10:57
'****************************************

Public Function MatrizVacia(vntMatriz As Variant) As Boolean 
  Dim lngTamaño As Long 
  On Error Resume Next 

Public Function MatrizVacia(vntMatriz As Variant) As Boolean 
  Dim lngTamaño As Long 
  On Error Resume Next 

Public Function MatrizVacia(vntMatriz As Variant) As Boolean 
  Dim lngTamaño As Long 
  On Error Resume Next 

  ' compruebo el tamaño de la matriz 
  lngTamaño = UBound(vntMatriz) 

  ' si está vacía se produce un error 
  If Err.Number = 9 Then 
    MatrizVacia = True 
  Else 
    MatrizVacia = False 
  End If

MatrizVacia_Salir: 
  On Error GoTo 0 
  Exit Function 
End Function            ' MatrizVacia

Por Emilio Sancha - 5 de Septiembre, 2005, 1:29, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Saldo Acumulado en formularios continuos

Por Marius Puig

Esta funcion calcula el saldo acumulado en un Formulario continuo para cada registro.

Uso: AWsaldo([FORMULARIO];"nombre_campo1";"nombre_campo2")

- [Formulario] debe escribirse tal como está, NO es el nombre del form)
- nombre_campo2 es opcional, si se incluye se restará del valor de nombre_campo1.

Ejemplos, en un cuadro de texto del Formulario:
=AWsaldo([Formulario];"IMPORTE")
=AWsaldo([Formulario];"DEBE";"HABER")

'* ******************************
'* Antes de usar la funcion, marcar en referencias:
'* Microsoft DAO 3.x
'* ******************************

Public Function AWsaldo(opObject, opFLD1, Optional opFLD2 = Null) As Currency

  Dim rst As DAO.Recordset, valACUM As Currency, fld1, fld2 
  On Error GoTo ErrAWsaldo 
  Set rst = opObject.RecordsetClone 
  With rst 
    Set fld1 = .Fields(opFLD1) 
    If IsNull(opFLD2) Then 
      fld2 = 0 
    Else 
      Set fld2 = .Fields(opFLD2) 
    End If

    .Bookmark = opObject.Bookmark 
    Do While Not .BOF() 
      valACUM = valACUM + fld1 - fld2 
      .MovePrevious 
    Loop 
  End With 
  Set fld1 = Nothing 
  Set fld2 = Nothing 
  Set rst = Nothing 

ErrAWsaldo: 
  AWsaldo = valACUM
End Function

Por ErBuho - 5 de Septiembre, 2005, 1:28, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Impedir abrir Form si otro está abierto

Esta función impide abrir un formulario mientras otro usuario este usando ese (u otro) formulario, en un entorno FrontEnd / BackEnd

Uso:

Private Sub Form_Open(Cancel As Integer)
If Not AWformUnico() Then
    Cancel = True
    Exit Sub
End If
'...
End Sub

'******************************

'* Marcar en referencias:

'* Microsoft DAO 3.x

'* Windows Script Host Object Model (wshom.ocx)

'*

'* Si no usamos WSHOM borrar las lineas  'referencia a wshom

'* (Esta funcion debe incluirse dentro del modulo del Form) '

'*

'* ******************************

Private Function AWformUnico() 

  Static dbsUnico As DAO.Database 

  Dim tbl As DAO.TableDef, dbs As DAO.Database 

  Dim AWrutaDb, AWconnectDb, AWrutaDbForm, usrName 

  Dim shellTMP As New IWshNetwork_Class 'referencia a wshom

  On Error GoTo errorAWformUnico

  For Each tbl In CurrentDb.TableDefs 

    If tbl.Connect > "" Then 

      AWrutaDb = Mid(tbl.Connect, InStr(tbl.Connect, "DATABASE=") + 9) 

      AWconnectDb = Left(tbl.Connect, InStr(tbl.Connect, "DATABASE=") - 2) 

      AWrutaDbForm = Left(AWrutaDb, InStrRev(AWrutaDb, "\")) & "DbForm.mdb" 

      If Dir(AWrutaDbForm) = "" Then 

        DBEngine.Workspaces(0).CreateDatabase AWrutaDbForm, dbLangGeneral 

      End If 

      Set dbs = OpenDatabase(AWrutaDb, False, False, AWconnectDb) 

      Set dbsUnico = OpenDatabase(AWrutaDbForm, True, False)

      On Error Resume Next

      dbs.Properties.Delete "DbForm" 

      usrName = CurrentUser 

      usrName = usrName & " (" & shellTMP.ComputerName & "/" & hellTMP.UserName & ")"

      ' linea superior, referencia a wshom 

      On Error GoTo errorAWformUnico 

      dbs.Properties.Append dbs.CreateProperty("DbForm", DB_TEXT, usrName) 

      dbs.Close 

      Exit For 

    End If 

  Next 

  AWformUnico = True 

AWformUnicoExit: 

  Set dbs = Nothing 

  Exit Function 

 

errorAWformUnico:

  If Err.Number = 3045 Then 

    MsgBox "En este momento " & dbs.Properties("DbForm").Value & vbNewLine _ 

    & "esta usando este formulario. " & vbNewLine & vbNewLine & "Intentelo mas tarde." _ 

    , vbInformation, "No puede abrir " & Me.Caption

    AWformUnico = False 

  Else 

    MsgBox Err.Description 

  End If 

  Resume AWformUnicoExit

End Function

Por ErBuho - 5 de Septiembre, 2005, 1:27, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Cerrar Recordset

Por Emilio Sancha:

Aquí va la primera mía

¿Cuantas veces al fallar algo en un proceso habéis recibido un error al cerrar un recordset por que realmente no se había llegado a abrir?

Usando esta función para cerrar el recordset no habrá errores aunque no se haya abierto, está basada en una idea original del gran McPegasus

'*******************************************************************************

'* CierraRecordset

'* Cierra el recordset indicado

'* Argumentos: rst => nombre del recordset

'* uso: CierraRecordset rst

'* ESH 22/05/04 13:21

'*******************************************************************************

Public Sub CierraRecordset(rst As DAO.Recordset) 

  On Error GoTo CierraRecordset_TratamientoErrores 

  If Not rst Is Nothing Then 

    rst.Close 

    Set rst = Nothing 

  End If          ' CierraRecordset  

CierraRecordset_Salir:

  On Error GoTo 0

  Exit Sub

  CierraRecordset_TratamientoErrores:  

  MsgBox "Error " & Err.Number & " en proc. CierraRecordset de Módulo Módulo2 (" & Err.Description & ")", vbOKOnly + vbCritical

  GoTo CierraRecordset_Salir

End Sub         ' CierraRecordset

Por ErBuho - 5 de Septiembre, 2005, 1:26, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Abrir pagina Web desde Access

Existen varios métodos para abrir una página Web desde Access. En este caso cito uno bastante curioso. (Necesita que el IE de Microsoft sea el explorador predeterminado):

Sub AbreUrl()

  Dim objIE As Object 

  Set objIE = CreateObject("InternetExplorer.Application") 

  With objIE 

    .MenuBar = False 

    .AddressBar = False 

    .StatusBar = False 

    .Toolbar = False 

    .Navigate http://www.mvp-access.com/buho/novedades.htm 

    .Visible = True 

  End With 

  Set objIE = Nothing

End Sub

De esta forma podemos controlar el tipo de ventana del IE

Por ErBuho - 5 de Septiembre, 2005, 1:25, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Objeto ClipBoard en Access

En VBA de Access no existe el objeto Clipboard. A veces nos encontramos con la necesidad de copiar el contenido de un campo o de una expresión en el porta-papeles de Windows, para volcarlo posteriormente en cualquier otro sitio.

El tema es relativamente sencillo de hacer, cuando nos movemos en una misma aplicación. Me explico. Si yo quiero conservar el valor de un campo para utilizarle en otro campo de cualquier otro formulario, bastará con declarar en un módulo Bas de nuestra aplicación, una variable Public que almacene dicho valor. Por ejemplo:

Dim MiClipboard As String

Si en Frm1 deseo «copiar» el contenido de Micampo1, bastaría, simplemente:

MiClipboard=Me.Micampo1

Y posteriormente, si deseo volcar ese valor en Micampo2 de otro formulario, simplemente poner:

Me.Micampo2 = MiClipboard

Al fin y al cabo, hemos simulado un copy-paste y en muchas ocasiones puede servir y bastar. Pero hay más técnicas para esto.

RunCommand

Me.Campo1.SetFocus

RunCommand acCmdCopy

y luego

Me.Campo2.SetFocus

RunCommand acCmdPaste


Actuar directamente sobre el objeto Portapapeles de Windows.

En VBA hay que refenciar previamente Proyecto > Componentes > "Microsoft Forms 2.0 Object Library", Es decir, la fm20.dll
Y luego, en efecto, instanacirla:


Dim ObjetoClipboard As MSForms.DataObject

Set ObjetoClipboard = New MSForms.DataObject

ObjetoClipboard.Clear  'esto borra el portapapeles

ObjetoClipboard.SetText "Esto va al portapapeles", 1

ObjetoClipboard.PutInClipboard

MsgBox "En el portapapeles actualmente hay: " & ObjetoClipboard.GetText


Si aplico esto al caso anterior....

Dim ObjetoClipboard As MSForms.DataObject

Set ObjetoClipboard = New MSForms.DataObject

ObjetoClipboard.Clear  'esto borra el portapapeles

ObjetoClipboard.SetText Me.Campo1, 1

Me.Campo2 = ObjetoClipboard.GetText

Vaciar el portapeles mediante API

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

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

Sub VaciaPortapapeles() 

  OpenClipboard Me.hwnd 

  'Vacia el portapapeles: 

  EmptyClipboard

End Sub

Por ErBuho - 5 de Septiembre, 2005, 1:24, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Tip Autodial de Access

Cuando nosotros colocamos en Access el codigo:
Application.Run "utility.wlib_AutoDial", "983222222"

realmente lo que estás cargando es un formulario del complemento de Access llamado Utility.mda
Este fichero le podrás buscar en tu disco duro, pues es uno de los varios MDA que acompañan al producto de Access.

En realidad, la llamada anterior, se hace a través de una funcion
(«wlib_autodial») que está dentro de ese completo, en el modulo de clase «utils».
Esa función abre el formulario «acr_frmautodial» que es en realidad el
formulario que se te muestra en pantalla cuando pones:
Application.Run "utility.wlib_AutoDial", "983222222"

¿Y que hace este formulario?
Pues nada mas que llamar a la API y marcar el numero de telefono que
escribas en la caja de texto, y que dicho formulario recibe como parametro desde Application.Run "utility.wlib_AutoDial", "983222222"
(En este caso 983222222)
En resumen...y yendo a las tripas de todo esto, ese complmento, en esa parte, lo unico que hace es llamar a la api de esta forma:

Declare Function TAPI_Make_Call Lib "tapi32.dll" _Alias  "tapiRequestMakeCall" _

(ByVal stNumber As String, _

ByVal  stDummy1 As String, _

ByVal  stDummy2 As String, _

ByVal  stDummy3 As String) As Long


y ejecuta esta funcion, así de simple.

Por lo tanto, podemos pasar de poner ese código  Application.Run "utility.wlib_AutoDial", "983222222" y construirnos un marcador telefónico al margen del complemento de access y del formulario mencionado. La función, todo junto ya, puesto en un módulo, podría quedar:

Option Explicit

Declare Function TAPI_Make_Call Lib "tapi32.dll" _

Alias  "tapiRequestMakeCall" _

(ByVal stNumber As String, _

ByVal  stDummy1 As String, _

ByVal  stDummy2 As String, _

ByVal  stDummy3 As String) As Long

Function MarcaTelefono(Numero As String) 
  Dim VarRet As Long 
  If IsNumeric(Numero) = True Then 
    VarRet = TAPI_Make_Call(Numero, "", "", "") 
  End If
End Function

Y obtendrías el mismo resultado, pero sin el formulario de DAR conformidad para marcar el numero de TF.

Desde cualquier formulario, que tenga un campo de texto con un número de teléfono, bastaría que asociaras a un boton de comando este codigo:

MarcaTelefono Me.TxtTelefono

donde TxtTelefono es una caja / campo de texto con el numero de telefono a marcar

Saludos del Búho

Function MarcaTelefono(Numero As String) 
  Dim VarRet As Long 
  If IsNumeric(Numero) = True Then 
    VarRet = TAPI_Make_Call(Numero, "", "", "") 
  End If
End Function

Y obtendrías el mismo resultado, pero sin el formulario de DAR conformidad para marcar el numero de TF.

Desde cualquier formulario, que tenga un campo de texto con un número de teléfono, bastaría que asociaras a un boton de comando este codigo:

MarcaTelefono Me.TxtTelefono

donde TxtTelefono es una caja / campo de texto con el numero de telefono a marcar

Saludos del Búho

Por ErBuho - 5 de Septiembre, 2005, 1:23, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Usuario de Windows

Es una pregunta que se suele repetir: Saber el nombre del usuario que ha iniciado sesión en Windows. Formas de hacerlo...varias.

Primera Forma: API

Option Explicit

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _     "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function DameUsuarioApi() As String 

  'Utilizando API de Windows 

  Dim lngLen As Long, lngX As Long 

  Dim strUserName As String 

  strUserName = String$(254, 0) 

  lngLen = 255 

  lngX = apiGetUserName(strUserName, lngLen) 

  If lngX <> 0 Then 

    DameUsuarioApi = Left$(strUserName, lngLen - 1) 

  Else 

    DameUsuarioApi = "Incapaz de detectar usuario." 

  End If

End Function

Segunda Forma: Variables de Entorno

Function DameUsuarioSencilla() As String 

  'Utilizando Variables de entorno 

  DameUsuarioSencilla = Environ("USERNAME")
End Function

Tercera forma: Utilizando Windows Script Host

Function DameNombreUsuarioWSH() As String 

  'Dos lineas y me devuelve el nombre del PC y del usuario Activo 

  'Mas facil, imposible 

  'Buho Junio 2003 

  Dim ObjetoRed As Object 

  Set ObjetoRed = CreateObject("WScript.Network") 

  MsgBox "Nombre del PC en Red : " & ObjetoRed.ComputerName & vbCrLf _ 

      & "Usuario: " & ObjetoRed.UserName, vbInformation, "Aviso" 

  DameNombreUsuarioWSH = ObjetoRed.UserName 

  Set ObjetoRed = Nothing

End Function

Por ErBuho - 5 de Septiembre, 2005, 1:22, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Ruta de las Tablas Vinculadas

Para saber desde código la ruta de las tablas vinculadas a una MDB concreta, se pueden implementar funciones que así nos lo muestren. Aquí van dos, una utilizando el objeto Tabledef de Dao y otra sacando esta información de la tabla del sistema MSysObjects, en concreto, de su campo Database.

Primer método DAO

Function RutaVInculacion() As String 

  Dim tbfSrc As DAO.TableDef 

  Dim NombreBase As String 

  Dim RutaBase As String 

  For Each tbfSrc In CurrentDb.TableDefs 

    If (tbfSrc.Connect <> "") Then    'esta es vinculada 

      NombreBase = Mid(tbfSrc.Connect, InStrRev(tbfSrc.Connect, "\") + 1) 

      MsgBox "Catón, el nombre de la base es: " & NombreBase 

      RutaBase = Replace(Mid(tbfSrc.Connect, InStrRev(tbfSrc.Connect, _

      "=") + 1), NombreBase,"") 

      MsgBox "Caton, la ruta es: " & RutaBase 

      'devolvemos la ruta 

      RutaVInculacion = RutaBase 

      Exit Function 

    End If 

  Next

End Function

Segundo Método

Function RutaVInculacion() As String 

  Dim PosibleRuta As String 

  PosibleRuta = Nz(DLookup("Database", "MSysObjects", _ 

                           "len([Database])<>0"), "")  

  If PosibleRuta <> "" Then 

    PosibleRuta = Replace(PosibleRuta, Mid(PosibleRuta, _ 

                  InStrRev(PosibleRuta, "\") + 1), "") 

    RutaVInculacion = PosibleRuta 

  End If

End Function

Por ErBuho - 5 de Septiembre, 2005, 1:20, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)

Otros mensajes en Access con Codigo VBA




<<   Septiembre 2017    
LMMiJVSD
        1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30  

Enlaces
eGrupos
ZoomBlog

 

Blog alojado en ZoomBlog.com