Para detener la ejecución de un código se puede utilizar la función ’sleep’, medienta la declaración en nuestro formulario la siguiente API de la siguiente forma:
Private Declare Sub Sleep Lib “kernel32″ (ByVal dwMilliseconds As Long)
A la cual llamaremos de la forma siguiente, donde el tiempo se indica en milisegundos, así 1000 corresponde un 1 segundo.
Sleep 1500
Las cosas deberían ser lo más simples posible, pero no más simples.
Haz todo tan simple como sea posible, pero no más simple.
Albert Einstein
Con el siguiente código se abre la aplicación Microsoft Word y se ‘escribe’ en ella. Para conocer los comandos que dan formato al documento, y la forma en que lo hacen, yo me he apoyado en una macro realizada desde el archivo Word.
Private Sub cmdWord_Click()
'Variables que utilizaremos
Dim AppWord As New Word.Application
Dim Documento As Word.Document
Dim Rango As Word.Range
Dim Parrafo As Paragraph
'Si queremos que se vea en la pantalla
AppWord.Visible = True
'Creamos un nuevo documento
Set Documento = AppWord.Documents.Add
'Ponemos un titulillo
Set Rango = Documento.Sections(1).Range
Rango.ParagraphFormat.Alignment = wdAlignParagraphCenter
Rango.Font.Size = 24
Rango.Font.Bold = True
Rango.Text = "Probando desde VB"
'Pones la siguiente linea
Set Parrafo = Documento.Paragraphs.Add
Set Rango = Parrafo.Range.Next
Rango.ParagraphFormat.Alignment = wdAlignParagraphLeft
Rango.Font.ColorIndex = wdRed
Rango.Font.Size = 16
Rango.InsertBefore ("El valor de Text1= ")
'Pones la siguiente linea
Set Parrafo = Documento.Paragraphs.Add
Set Rango = Parrafo.Range.Next
Rango.ParagraphFormat.Alignment = wdAlignParagraphLeft
Rango.Font.ColorIndex = wdRed
Rango.Font.Size = 16
Rango.InsertBefore ("El valor de Text2= ")
'Guardamos el documento
Documento.SaveAs "C:\prueba.doc"
'Cerramos la aplicacion
AppWord.Quit
'Descargamos los objetos
Set Documento = Nothing
Set Rango = Nothing
Set Parrafo = Nothing
Set AppWord = Nothing
End Sub
Fuente: www.todoexpertos.com
El siguiente ejemplo muestra cómo utilizar un formulario para avisar al usuario de la aplicación que ésta está trabajando, y no se ha quedado colgada.
Utiliza el siguiente código:
'Para abrir el formulario
Sub ShowPleaseWait()
DoCmd.OpenForm "f_PleaseWait"
Forms!f_PleaseWait.Repaint
End Sub
'Para cerrar el formulario
Sub ClosePleaseWait()
If CurrentProject.AllForms("f_PleaseWait").IsLoaded Then
DoCmd.Close acForm, "f_PleaseWait", acSaveNo
End If
End Sub
'Para cambiar el mensaje que muestra el formulario
Sub MsgPleaseWait(Optional pMsg As String = "PleaseWait...")
Forms!f_PleaseWait.Msg.Caption = pMsg
Forms!f_PleaseWait.Repaint
End Sub
Descargar. Access 2000
Fuente: Utter Access
La siguiente función delvuelve el nombre del equipo desde el que se está ejecutando la aplicación:
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Sub Command1_Click() Dim buffer As String * 512, length As Long length = Len(buffer) If GetComputerName(buffer, length) Then MsgBox "Nombre del equipo = " & Left$(buffer, length) End If
Con el siguiente código se crea en la base de datos una nueva barra de menú, llamada thisbar, a la que se le añade como elemento un cuadro de texto.
'Crea la barra de menú
Function CreateBar()
On Error Resume Next
Dim CB As Object
Dim Cbc As Object
Application.CommandBars("thisBar").delete
Set CB = CommandBars.Add(NAME:="thisBar")
Set Cbc = CB.Controls.Add(Type:=2)
With Cbc
'Tras entrar el texto en el msoControlEdit y presionar Enter la función getTextse ejecutará.
.OnAction = "getText"
'Establece el ancho del cuadro de texto
.Width = 100
.Caption = "TextonBar"
'Se usa el nombre de la etiqueta para hacer referencia al control msoControlEdit
.Enabled = True
End With
CB.Visible = True
End Function
La siguiente función devuleve el valor del cuadro de texto de la barra de menú, cuando se hace Intro desde dicho cuadro de texto.
'Devuelve el valor del cuadro de texto
Function getText()
Dim str1 As String
str1 = CommandBars("thisBar").Controls("TextonBar").Text
msgbox(str1)
End Function
Fuente: Utter Access
