Trucos en Visual Basic

Trucos en Visual Basic
Cmo redondear un nmero

Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Utilice la siguiente rutina para
redondear un nmero. Le devolver el nmero redondeado en formato Double con tantos
decimales como indique en el parmetro 'intCntDec'.
Public Function Redondear (dblnToR As Double,_
Optional intCntDec As Integer) As Double
Dim dblPot As Double
Dim dblF As Double
If dblnToR < 0 Then dblF = -0.5 Else: dblF = 0.5
dblPot = 10 ^ intCntDec
Redondear = Fix(dblnToR * dblPot * (1 + 1E-16) + dblF) / dblPot
End Function
Cmo dibujar letras en tres dimensiones en Visual Basic
Aplicable a Microsoft Visual Basic 6 Para dibujar letras en tres
dimensiones en Visual Basic lo nico que hay que hacer crear un
formulario e introducir en l un Command Button con el siguiente cdigo:
Private Sub Command1_Click()
Dim I As Integer, X As Integer, Y As Integer
ForeColor = &HFF0000: X = CurrentX: Y = CurrentY
CurrentX = X: CurrentY = Y: FontSize = 14
For I = 1 To 50
Print "Texto en tres dimensiones"
X = X + 1: Y = Y + 1: CurrentX = X: CurrentY = Y
Next I
ForeColor = &HFF00&
Print "Texto en tres dimensiones"
End Sub
Donde en vez de "Texto en tres dimensiones" pondremos el texto que
queramos.
Cmo pasar de un control a otro pulsando Intro
Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Para pasar de un
control a otro pulsando Intro utilice la siguiente cdigo en el evento
KeyPress de cada control. El orden que siguen ser el marcado en la
propiedad TabIndex.
If KeyAscii = 13 Then
SendKeys "{Tab}", True
End If
Cmo juntar los contenidos de dos archivos
Aplicable a Microsoft Visual Basic 5, Visual Basic 6 El comando copy de
DOS permite coger los contenidos de dos ficheros y ponerlos
secuencialmente en un tercero. En Visula basic se puede hacer lo mismo
utilizando con la siguiente rutina:
Public Function Sub Join Files (Source1 as String,_
Source2 as String, Dest as Sting)
Dim Buffer() as Byte
Open Source1 for Binary Access Read as #1
Open Source2 for Binary Access Read as #2
Open Dest for Binary Access Write as #3
ReDim Buffer(1 To LOF(1))
Get #1, ,Buffer
Get #3, ,Buffer
ReDim Buffer(1 To LOF(2))
Get #2, ,Buffer
Get #3, ,Buffer
Close #1, #2, #3
End Sub.
Cmo pedir confirmacin de descarga de un formulario
Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Quizs a veces desee
dar a los usuarios la opcin de confirmar que desean descargar un
formulario. En vez de utilizar una funcin MsgBox y un Select Case, puede
incluir este cdigo en el evento Form_Unload.
Private Sub Form_Unload (Cancelar as Integer)
Cancelar = (MsgBox ("Salir?", vbOKCancel Or _
vbQuestion, "Demo Confirmacion") = vbCancel)
End Sub
Detrs del botn Salir y de la opcin Salir del men, ponga simplemente
Unload Me. Cada vez que un usuario quiera salir se les pedir
confirmacin.
Cmo obtener el directorio desde donde estamos ejecutando nuestro
programa
Aplicable a Microsoft Visual Basic 6 Para obtener el directorio desde
donde estamos ejecutando nuestro programa lo nico que hay que hacer es
utilizar este cdigo:
Private Sub Form_Load()
Dim Directorio as String
ChDir App.Path
ChDrive App.Path
Directorio = App.Path
If Len(Directorio) > 3 Then
Directorio = Directorio & "\"
End If
Text1.Text = Directorio
End Sub
En este ejemplo el directorio aparecer en el cuadro de texto Text1.
Funcin creada por Eduardo Frneas. Originalmente publicada en
<http://www.arrakis.es/~eforneas/breves.htm>
Cmo colocar la hora y la fecha en la barra de ttulo de una MDI Form
Aplicable a Microsoft Visual Basic 6 Para colocar la hora y la fecha en
la barra de ttulo de una MDI Form siga estos pasos:
Coloque un objeto timer en el formulario MDI.
El valor de la propiedad Interval del objeto timer debe ser 1000.
Elimine el valor de la propiedad caption de la forma MDI.
En el procedimiento Timer del objeto escriba el siguiente cdigo:
<NombreForm>.Caption = "<Nombre de la aplicacin>" &
Format(Date, "dd-mm-yyyy") & " " & Format(Now, "h:nn:ss AM/PM")
Donde NombreForm el el nombre de su formulario MDI y Nombre de la
aplicacin es el nombre que le quiere dar.
En el procedimiento Load del formualario escriba el siguiente cdigo:
timer1.Enabled = true
Funcin originalmente publicada en <http://www.compuconsult.com.ve/>
Cmo hacer desaparecer el cursor del ratn
Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Para hacer
desaparecer y aparecer el cuesor del ratn pegue el siguiente cdigo en
el mdulo:
Declare Function ShowCursor Lib "user32" (ByVal bShow_
As Long) As Long
Debe crear dos botones con:
result = ShowCursor(False)
End Sub
y
result = ShowCursor(True)
End Sub
Es muy importante que, en el caso del botn2 que hace reaparecer el
cursor, permita seleccionarlo desde el teclado poniendo su propiedad
Caption a &Mostrar.
Funcin creada por Eduardo Frneas. Originalmente publicada en

<http://www.arrakis.es/~eforneas/breves.htm>
Cmo saber si un array est correctamente dimensionado
Aplicable a Microsoft Visual Basic 6 En ocasiones es necesario declarar
un array vaco para posteriormente utilizar ReDim y asignarle el espacio
que nosotros indiquemos. En un momento dado, puede ser til comprobar en
el programa si el array ha sido ya creado o no. La siguiente funcin
devuelve True si el array dinmico no ha sido dimensionado:
Public Function EstaArrayVacio(aArray as Variant) as Boolean
On Error Resume Next
EstaArrayVacio = UBound(aArray)
EstaArrayVacio = Err ' Error 9 (Subscript out of range)
End Function
Utilice el siguiente cdigo para probar la funcin:
Dim aDynamic() as Integer
MsgBox EstaArrayVacio(aDynamic)
ReDim aDynamic(8)
MsgBox EstaArrayVacio(aDynamic)
End Sub
Cmo abrir una base de datos con seguridad desde ADO
Aplicable a Microsoft Visual Basic 6 La seguridad utilizada
convencionalmente por Microsoft Access es una seguridad a nivel de
usuario, controlada desde los ficheros .MDB y .MDA o .MDW (segn versin
de Microsoft Access).
Microsoft Access 7.0 y Microsoft Access 97 tambin incorporan otro tipo
de seguridad, asociada a la base de datos (se protege la base de datos
con una contrasea que forma parte del fichero .MDB, y que solamente es
solicitada al abrir sta).
El cdigo aqu incluido permite abrir desde Visual Basic una base de
datos cuando hay establecida seguridad a nivel de usuario.
Previamente, desde el entorno de Microsoft Access se ha asignado al
usuario Administrador (que es por defecto el propietario de todas las
bases de datos) una contrasea ("ejemplo"). Esto se hace en Access 97 en
la opcin de men Herramientas, Seguridad, Cuentas de usuario y de grupo
y, una vez ah, accediendo a la pestaa Cambiar contrasea de conexin. A
partir de entonces, al abrir Access ser necesario proporcionar el
usuario y la contrasea.
Tambin a partir de entonces, para abrir un MDB desde VB ser necesario
pasarle el usuario y la contrasea.
Este es el cdigo VB que utiliza objetos de ADO 2.0 para abrir el MDB:
Dim Cn As New ADODB.Connection
Dim strCn As String
strCn = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=nwind.MDB;" & _
"Jet OLEDB:System database=c:\winnt\system32\System.MDW"
Cn.Open ConnectionString:=strCn, _
UserID:="Admin", Password:="moises"
NOTA: Aunque se disponga de Microsoft Access en idioma castellano y el
usuario se llame Administrador, es necesario pasar "Admin" como UserID, y
no "Administrador".
Cmo crear un salvapantallas con Visual Basic
Aplicable a Microsoft Visual Basic 6 La forma de crear un salvapantallas
con Visual Basic es muy simple. Basta con crear un proyecto con un
formulario al que se le aadirn los controles que conformarn el
interfaz del salvapantallas, junto al cdigo que se quiera incluir.
Al generar el fichero ejecutable se debe dar la extensin SCR, y el
fichero debe guardarse en el directorio por defecto de Windows.
Un ejemplo: crear un proyecto estndar en VB y asignar las siguientes
propiedades al formulario por defecto
WindowState = 2 'Maximized
BorderStyle = 0 'None
Incluir en el formulario una etiqueta con un texto descriptivo. Incluir a

continuacin el siguiente cdigo:
Private Sub Form_Click()
'El salvapantallas se desactiva al hacer click sobre el formulario
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'El salvapantallas se desactiva al pulsar una tecla
Unload Me
End Sub
'No se permita ms de una instancia del salvapantallas
If App.PrevInstance Then Unload Me
End Sub
Generar el fichero ejecutable con la extensin SCR, y guardarlo en el
directorio por defecto de Windows.
Si a continuacin indicamos ste como salvapantallas por defecto en las
propiedades del escritorio de Windows, cuando se venza el retardo de
tiempo indicado, el formulario maximizado ser visualizado como
salvapantallas. Para volver al escritorio bastar con pulsar una tecla o
hacer clic con el ratn.
Cmo detectar si una tarjeta de crdito es vlida
Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6 En
una aplicacin de comercio electrnico o una aplicacin que necesite
validar el nmero de una tarjeta de crdito, se puede hace uso del
algoritmo ISO 2894. Este algoritmo permite comprobar que la numeracin de
la tarjeta es correcta, pero obviamente no indica si la tarjeta sigue
siendo vlida (no ha sido anulada, ha caducado, etc.).
A continuacin, se muestra el cdigo Visual Basic para comprobar la
validez en la numeracin de una tarjeta de crdito:
Cree un nuevo proyecto en Visual Basic y aada una caja de texto y un
botn.
Pegue el siguiente cdigo:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EsCCValido
'
' Valida la tarjeta de crdito de acuerdo con el algoritmo ISO 2894
' El algoritmo es:
' 1. Calcular el peso para el primer dgito: si el nmero de dgitos
'
es par el primer peso es 2 de lo contrario es 1. Despus los
'
pesos alternan entre 1, 2, 1, 2, 1 ...
' 2. Multiplicar cada dgito por su peso
' 3. Si el resultado del 2 paso es mayor que 9, restar 9
' 4. Sumar todos los dgitos
' 5. Comprobar que el resultado es divisible por 10
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function EsCCValido(sTarjeta As String) As Boolean
Dim iPeso As Integer
Dim iDigito As Integer
Dim iSuma As Integer
Dim iContador As Integer
Dim sNuevaTarjeta As String
Dim cCaracter As String * 1
iPeso = 0
iDigito = 0
iSuma = 0
'Reemplazar cualquier no digito por una cadena vaca
For iContador = 1 To Len(sTarjeta)
cCaracter = Mid(sTarjeta, iContador, 1)
If IsNumeric(cCaracter) Then
sNuevaTarjeta = sNuevaTarjeta & cCaracter

End If
Next iContador
' Si es 0 devolver Falso
If sNuevaTarjeta = 0 Then
EsCCValido = False
Exit Function
End If
' Si el nmero de dgitos es par el primer peso es 2, de lo
' contrario es 1
If (Len(sNuevaTarjeta) Mod 2) = 0 Then
iPeso = 2
Else
iPeso = 1
End If
For iContador = 1 To Len(sNuevaTarjeta)
iDigito = Mid(sNuevaTarjeta, iContador, 1) * iPeso
If iDigito > 9 Then iDigito = iDigito - 9
iSuma = iSuma + iDigito
' Cambiar peso para el siguiente dgito
If iPeso = 2 Then
iPeso = 1
Else
iPeso = 2
End If
Next iContador
' Devolver verdadero si la suma es divisible por 10
If (iSuma Mod 10) = 0 Then
EsCCValido = True
Else
EsCCValido = False
End If
End Function
Private Sub btnComprobarCC_Click()
If EsCCValido(Text1) Then
MsgBox "Tarjeta vlida"
Else
MsgBox "Tarjeta invlida"
End If
End Sub
Ejecute la aplicacin. En la caja de texto introduzca el nmero de la
tarjeta de crdito y pulse el botn de comprobacin. Puede probar con
4242 4242 4242 4242 que es un nmero vlido
Cmo dar formato para celdas numricas en el control DBGRID
Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6 A
las columnas numricas de un dbgrid se les puede aplicar un formato de
visualizacin de los nmeros. Para establecer este formato a travs de
cdigo debe utilizarse la propiedad NumberFormat, pero en base al formato
americano. Por ejemplo, imaginemos que la tercera columna en un dbgrid es
una columna numrica en la que aparecen cifras de ventas con valores
decimales, y queremos visualizar el punto para las unidades de millar y
dos decimales tras la coma. Tenderemos a escribir el siguiente cdigo:
DBGrid1.Columns(2).NumberFormat = "#.###,##"
Pues bien, el resultado ser que, una vez ejecutado este cdigo, esa
columna aparecer en blanco. La razn es que esta propiedad debe
utilizarse en base al formato americano, o dicho de otro modo, el punto
decimal debe ser una coma (",") y la separacin de decimales un punto
("."). De esta forma, si utilizamos el siguiente cdigo:
DBGrid1.Columns(2).NumberFormat = "#,###.##"
el resultado s ser el correcto, y veremos los valores numricos en
dicha columna, y adems con el formato deseado (por ejemplo, 10.235,27).
PRECAUCIN: CUALQUIER UTILIZACIN POR SU PARTE DEL CDIGO INCLUIDO EN
ESTE ARTCULO SE HAR A SU CUENTA Y RIESGO. Microsoft facilita este
cdigo "tal cual" sin garanta de ningn tipo, ya sea explcita o
implcita, incluyendo expresamente en tal exencin de responsabilidad y,
a efectos meramente enunciativos y no limitativos, las garantas legales
mercantiles implcitas y/o la adecuacin a un propsito o finalidad en
particular.
Cmo lanzar sncronamente comandos de MS-DOS
Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6 A
veces interesa lanzar comandos MS-DOS desde Visual Basic y esperar a que
stos acaben. Una situacin habitual es lanzar ficheros por lotes (.BAT),
o comandos "net XXX", que realizan exploracin por distintos servidores
en la red y que pueden tardar varios segundos en ser ejecutados.
A continuacin se incluye un ejemplo de cmo lanzar un comando MS-DOS y
esperar a que ste acabe. Se utilizan dos funciones del API de Windows.
La declaracin de stas se ha obtenido del Visor de Texto API, un icono
que aparece en el grupo de programas de Visual Basic.
Estas funciones son:
OpenProcess(): a partir del identificador de un proceso en ejecucin esta
funcin devuelve el handle de dicho proceso.
GetExitCodeProcess(): recupera el cdigo de salida de un proceso lanzado.
Por otra parte, en el cdigo de ejemplo se incluye una referencia a
Environ$("Comspec") & " /c "
Esta instruccin fuerza a que se cierre la ventana MS-DOS de Windows 95 o
Windows 98 despus de que el comando MS-DOS se haya ejecutado. En
realidad la anterior instruccin se traduce en
"COMMAND.COM /C"
La utilizacin de la funcin Environ con el parmetro Comspec asegura que
el command.com se encontrar aunque no est en el path.
El ejemplo necesita un proyecto con un Textbox y un Command button, con
las propiedades por defecto. Al ejecutar el proyecto, teclear el comando
MS-DOS en el Textbox y pulsar Command1. Pasados unos segundos (depende
del comando a ejecutar), aparecer el mensaje "El comando ha acabado".
El cdigo del formulario es el siguiente:
Option Explicit
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) _
As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) _
As Long
Sub EsperarShell(sCmd As String)
Dim hShell As Long
Dim hProc As Long
Dim codExit As Long
' ejecutar comando
hShell = Shell(Environ$("Comspec") & " /c " & sCmd, 2)
' esperar a que se complete el proceso
hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
Do
GetExitCodeProcess hProc, codExit
DoEvents
Loop While codExit = STILL_ACTIVE
MsgBox "El comando ha acabado"
End Sub
EsperarShell (Text1.Text)
End Sub
Cmo depurar el SETUP1.VBP del asistente para instalar aplicaciones
Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6
Usted puede personalizar el asistente para la instalacin de aplicaciones
modificando el proyecto Setup1.vbp. Sin embargo, este proyecto no puede
ser depurado en el entorno de desarrollo (IDE) a menos que se emule el
comportamiento de la rutina de instalacin.
Para depurar el proyecto Setup1.vbp en el IDE siga los siguientes pasos:
Ejecute el asistente para instalar aplicaciones (tambin conocido como
asistente para empaquetado y distribucin) y cree unos discos de
instalacin en un directorio.
Edite el fichero Setup.lst en un editor de texto y haga las siguientes
modificaciones:
Visual Basic 4.0 16-bit
Localice:
Setup=setup1.exe
y reemplzelo con:
Setup=c:\vb\vb.exe c:\vb\setupkit\setup1\setup1.vbp /cmd
Visual Basic 4.0 32-bit
Localice:
Setup=setup132.exe
y reemplzelo con:
Setup=c:\vb\vb32.exe c:\vb\setupkit\setup1\setup1.vbp /cmd
Visual Basic 5.0
Localice:
Setup=setup1.exe
y reemplzelo con:
Setup="c:\archivos de programa\devstudio\vb\vb5.exe"
"c:\archivos de programa\devstudio\vb\setupkit\setup1\setup1.vbp" /cmd
Visual Basic 6.0
Localice:
Spawn=setup1.exe
y reemplzelo con:
Spawn="C:\Archivos de Programa\Microsoft Visual Studio\VB98\VB6.exe"
"C:\Archivos de Programa\Microsoft Visual Studio\VB98\Wizards\
PDWizard\Setup1\Setup1.vbp" /cmd
Comience la instalacin ejecutando Setup.exe.
Cuando Setup.exe termina, se ejecuta el IDE de Visual Basic cargando el
proyecto Setup1.vbp. Establezca los puntos de ruptura que considere
oportunos para hacer la depuracin y pulse F5 o F8.
Cmo detectar el estado de un impresora local
Aplicable a Microsoft Visual Basic 6 Las funciones de la API de Windows
para comprobar el estado de una impresora requieren que haya un documento
en el spooler. Esta restriccin obliga, en la mayora de los casos, a
mandar un trabajo de impresin para detectar el estado de la impresora.
Para evitar este incoveniente se puede abrir el puerto de la impresora
(normalmente lpt1) con CreateFile y tratarlo como un puerto de
comunicaciones normal. La API ClearCommError permite detectar errores en
el puerto.
El siguiente ejemplo muestra cmo examinar el estado de una impresora
(este mtodo slo funciona para impresoras locales) :
Cree un nuevo proyecto.
Aada un mdulo de proyecto.
Copie el siguiente cdigo en el mdulo de proyecto:
Public Const GENERIC_WRITE = &H40000000
Public Const GENERIC_READ = &H80000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const CREATE_ALWAYS = 2
Public Const OPEN_ALWAYS = 4

Public Const INVALID_HANDLE_VALUE = -1
Public Type COMSTAT
Filler1 As Long
Filler2 As Long
Filler3 As Long
Filler4 As Long
Filler5 As Long
Filler6 As Long
Filler7 As Long
Filler8 As Long
Filler9 As Long
Filler10 As Long
End Type
Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _
As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As
Long
Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long,
lpErrors As Long, _
lpStat As COMSTAT) As Long
Public Const CE_BREAK = &H10 ' break condition
Public Const CE_PTO = &H200 ' printer timeout
Public Const CE_IOE = &H400 ' printer I/O error
Public Const CE_DNS = &H800 ' device not selected
Public Const CE_OOP = &H1000 ' out of paper
Coloque un botn en el formulario y copie el siguiente cdigo:
Dim mHandle As Long
Dim lpErrors As Long
Dim x As COMSTAT
mHandle = CreateFile("lpt1", GENERIC_WRITE Or GENERIC_READ, _
0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If mHandle < 0 Then
MsgBox "error de apertura del puerto " & mHandle
Else
If ClearCommError(mHandle, lpErrors, x) = False Then
MsgBox "Error en ClearCommError"
End If
End If
If lpErrors And CE_BREAK Then
MsgBox "Error genrico"
End If
If lpErrors And CE_PTO Then
MsgBox "Timeout de impresora"
End If
If lpErrors And CE_IOE Then
MsgBox "Error de entrada/salida"
End If
If lpErrors And CE_DNS Then
MsgBox "Dispositivo no seleccionado"
End If
If lpErrors And CE_OOP Then
MsgBox "Sin papel"
End If
CloseHandle mHandle
End Sub
Ejecute la aplicacin y pulse el botn para comprobar el estado de la

impresora.
Cmo minimizar todas las ventanas
Aplicable a partir de Microsoft Visual Basic 4.0 32 Bits
En Visual Basic es fcil minimizar todas las ventanas visibles mediante
programacin
usando el API keybd_event.
El truco consiste en imitar los eventos de teclado requeridos para abrir
el men de la
barra de tareas y enviar la letra "M" para seleccionar la opcin
"Minimizar todas las
ventanas".
Con tres llamadas al API keybd_event podremos conseguirlo.
El segundo argumento de la llamada a keybd_event es el cdigo de tecla
(hardware scan
code), y en este caso podramos usar el valor 91, sin embargo dado que
las aplicaciones
podran no usar este cdigo, se ha dejado a cero.
Ejemplo paso a paso
------------------1. Inicie un nuevo proyecto EXE. Form1 se crea por defecto.
2. Aada un botn de comando en Form1.
3. Copie y pegue el siguiente cdigo en la ventana de cdigo de Form1.
Private Declare Sub keybd_event Lib "user32" ( ByVal bVk As Byte,_
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_LWIN = &H5B
' 77 is the character code for the letter 'M'
Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(77, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
End Sub
4. Pulse la tecla F5 para ejecutar la aplicacin y haga clic en el botn
de comandos,
se minimizarn todas las ventanas
Cmo ejecutar como procedimiento el contenido de un string
Aplicable a partir de Microsoft Visual Basic 4.0 En Visual Basic se est
avanzando en la posibilidad de ejecutar el cdigo apuntado por un puntero
a funcin, tal y como se permite en Visual C++.
Ya en Visual Basic 5.0 se incorporaba la funcin AddressOf, que permita
obtener la direccin de una funcin. Pasando esa direccin a un programa
C++, ste poda ejecutar la funcin.
En Visual Basic 6.0 se avanza un paso ms y se crea la funcin
CallByName, que permite ejecutar una funcin si se conoce su nombre en
tiempo de ejecucin. Basta con pasar a CallByName una cadena (string)
como argumento, conteniendo el nombre de la funcin a ejecutar. Los
argumentos que recibe CallByName son: el objeto contenedor de la funcin
(por ejemplo, un Formulario), la cadena que contiene el nombre de la
funcin, el tipo de funcin y los argumentos de sta.
El siguiente ejemplo crea dos funciones (Divide y Multiplica). Si en
Text2 y Text3 colocamos los argumentos, al pulsar el botn se ejecuta la
operacin que hallamos escrito en Text1 (Multiplica o Divide).
Public Function Divide(arg1 As Long, arg2 As Long)
Divide = arg1 / arg2
End Function
Public Function Multiplica(arg1 As Long, arg2 As Long)
Multiplica = arg1 * arg2
End Function
MsgBox CallByName(Me, Text1.Text, VbMethod, Text2.Text, Text3.Text)

End Sub
Cmo establecer los mrgenes de la impresora
Aplicable a partir de Microsoft Visual Basic 4.0 Para indicar los
mrgenes de un trabajo de impresin hay que utilizar las propiedades de
escala de la impresora.
El siguiente ejemplo establece el margen izquierdo a 0'6 pulgadas y el
margen superior a 0'7 pulgadas. El factor 1440 convierte las pulgadas a
twips: Printer.ScaleLeft = -0.6 * 1440
Printer.ScaleTop = -0.7 * 1440
Printer.CurrentX = 0
Printer.CurrentY = 0
Cmo testear la lnea de comandos
Aplicable a partir de Microsoft Visual Basic 4.0 Durante el desarrollo de
una aplicacin en el entorno integrado de Visual Basic, a veces es
necesario probar los parmetros que se le pasan en la lnea de comandos.
En Visual Basic, se puede indicar la lnea de comandos en tiempo de
depuracin de la siguiente forma:
En Visual Basic 4:
Seleccione el men Herramientas.
Elija Opciones.
Muestre la pestaa Avanzado.
Introduzca los parmetros en "Argumentos de la lnea de comandos".
En Visual Basic 5 y 6:
Seleccione el men Proyecto.
Elija la opcin Propiedades.
Muestre la pestaa Generar.
Introduzca los parmetros en "Argumentos de la lnea de comandos".
Cmo desplazar el cursor hasta el final de una caja de texto
Aplicable a partir de Microsoft Visual Basic 4.0 En ocasiones es
necesario que cuando el usuario sita el foco en una caja de texto, la
introduccin de datos comience al final del texto previamente
introducido.
Para desplazar el cursor al final del texto, teclee el siguiente texto en
el evento GetFocus de la caja de texto:
Private Sub Text1_GotFocus()
Text1.SelStart = Len(Text1.Text)
End Sub
Cmo obtener la operacin realizada sobre un formulario modal
Aplicable a partir de Microsoft Visual Basic 4.0 A veces es necesario
mostrar un formulario modal donde el usuario introduzca una serie de
datos y despus pulse Aceptar o Cancelar. En funcin de la operacin
realizada (Aceptar o Cancelar) se puede mostrar un segundo formulario con
ms informacin o con los resultados de la operacin. Desafortunadamente,
no es posible lanzar otro dilogo desde el formulario modal ya que ste
ltimo debe permanecer en primer plano. Para evitar este problema, se
puede utilizar una variable booleana en el formulario modal que indique
la operacin realizada por el usuario. Al descargar el formulario, sus
variables no desaparecen sino que siguen memoria, por lo que se pueden
consultar desde un segundo formulario y actuar en consecuencia.
A continuacin se muestra un ejemplo:
1. Aada formularios al proyecto (Form1 y Form2)
2. Site un botn (Command1) en Form1
3. Site dos botones (Command1 y Command2)en Form2
4. Escriba el siguiente cdigo en Form1:
Private Command1_Click()
Form2.Show vbModal
If Form2.Operacion Then
MsgBox "Operacin A"
Else
MsgBox "Operacin B"
End If
Set Form2 = Nothing

End Sub
5. Escriba el siguiente cdigo en Form2:
Public Operacion as Boolean
Operacion = True
Unload Me
End Sub
Operacion = False
Unload Me
End Sub
Ejecute el proyecto y pruebe a pulsar el botn del formulario uno y
despus a pulsar cualquier botn del formulario dos.
Cmo aadir controles dinmicamente en formularios
Aplicable a partir de Microsoft Visual Basic 6.0 Hasta Visual Basic 5.0
si se quera aadir un control a un formulario se utilizaba la funcin
Load, que permita aadir un control a un array ya existente. Esta
limitacin se ha eliminado de Visual Basic 6.0, y ya es posible aadir y
borrar controles a la coleccin "Controls", sin necesidad de que exista
un array ya creado. Adems, el nuevo control puede responder a eventos si
se define con la palabra "WithEvents".
Como muestra, un sencillo ejemplo que crea un botn y se aade cdigo al
evento:
Dim WithEvents cmdObj1 As CommandButton
Private Sub cmdObj1_Click()
MsgBox "Esto es un control dinmico"
End Sub
Set cmdObj1 = Form1.Controls.Add("VB.CommandButton", "cmdBoton1")
cmdObj1.Caption = "Plsame"
cmdObj1.Left = 1500
cmdObj1.Top = 1000
cmdObj1.Visible = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form1.Controls.Remove "cmdBoton1"
End Sub
Cmo desactivar los repintados de una ventana
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits En ocasiones es
conveniente que durante un cierto tiempo una ventana determinada no
produzca repintados, ya que la informacin que se quiere mostrar es
amplia y no interesa que el usuario vaya viendo cmo se va generando. La
funcin LockWindowUpdate permite inhibir los repintados hasta que se
vuelva a llamar de nuevo a esta funcin con el parmetro NULL.
Al llamar a la funcin LockWindowUpdate, la ventana no procesa los
repintados no pudiendo tampoco el usuario moverla de posicin.
A continuacin, se muestra un ejemplo:
Cree un nuevo proyecto con dos botones y una caja de texto.
Copie el siguiente cdigo en el formulario:
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
LockWindowUpdate Me.hWnd
Text1 = "prueba"
End Sub
LockWindowUpdate 0&
End Sub
Pulse el botn Command1. Comprobar que la caja de texto no cambia a
pesar de modificar su propiedad Text. Si pulsa el botn Command2 podr
observar cmo se reflejan los cambios.
Cmo obtener un puntero a una variable
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Una de las
caractersticas de Visual Basic que los programadores de C o Pascal echan
de menos es el uso de punteros. Visual Basic 5.0 proporciona una serie de
funciones no documentadas ni soportadas que permiten obtener un puntero a
una variable, a un objeto o una cadena. Con un poco de imaginacin y
gracias a esta nueva funcionalidad se pueden construir listas enlazadas,
rboles, etc., que permitan superar las limitaciones de Visual Basic. A
continuacin, se describen estas funciones no documentadas:
VarPtr(nombre_variable): obtiene un puntero a una variable de tipo
Integer, Long, etc., excepto String. StrPtr(nombre_variable_string):
obtiene un puntero a una variable de tipo String.
ObjPtr(nombre_variable_objeto): obtiene un puntero a una variable de tipo
objeto.
Ejemplo:
Dim x As String * 255
Dim y As New Form1
Dim z As Integer
MsgBox StrPtr(x)
MsgBox ObjPtr(y)
MsgBox VarPtr(z)
Cmo registrar/desregistrar controles ActiveX rpidamente
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits A continuacin,
se indica cmo registrar/desregistrar DLLs y OCXs, asociando un tipo de
fichero con una accin:
Desde el "Explorador de Windows" seleccione en el men Ver\Opciones y
elija la pestaa "Tipos de Archivo".
Haga clic en el botn "Nuevo tipo".
Rellene el campo "Descripcin del tipo". Ejemplos:
Ficheros DLL
Ficheros OCX
Rellene el campo "Extensin asociada". Ejemplos:
DLL
OCX
Haga clic en el botn "Nueva" para aadir una accin al tipo de fichero.
Rellene el campo "Accin". Ejemplos:
Registrar
DeRegistrar
En el campo "Aplicacin utilizada para realizar la accin" indique la
aplicacin Regsvr32.exe. Ejemplos:
Para registrar un fichero utilice Regsvr32.exe.
Para desregistrar un fichero utilice Regsvr32.exe /u.

Observe que Regsvr32 es slo para ficheros de 32-bit. Si intenta
registrar ficheros de 16-bit ocurrir un error.
Cmo evitar utilizar variables no declaradas
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Visual Basic
ofrece la posibilidad de utilizar variables que no han sido declaradas
previamente (con la instruccin Dim por ejemplo). Cuando esto ocurre, VB
asume que las variables no declaradas son de tipo Variant. El problema de
utilizar variables no declaradas es que es complejo depurar una
aplicacin.
Se puede evitar esta situacin situando la instruccin Option Explicit en
la seccin General Declaraciones de un mdulo o formulario. Si su cdigo
incluye alguna variable no declarada se recibir un error en tiempo de
compilacin
Cmo rellenar un ComboBox con los meses del ao
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits A continuacin,

se muestra una tcnica para llenar de forma sencilla un ComboBox con los
meses del ao:
For i = 1 To 12
Combo1.AddItem Format("28/" & i _
& "/1997", "mmmm")
Next
Cmo evitar mltiples instancias de una misma aplicacin
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Se puede evitar
fcilmente que los usuarios ejecuten varias instancias de la misma
aplicacin, haciendo uso de la propiedad PrevInstance del objeto App:
If App.PrevInstance Then
MsgBox "La aplicacin ya est abierta"
Unload Me
End If
Cmo evitar que los complementos se ejecuten al lanzar Visual Basic
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Cuando se
ejecuta Visual Basic 4 o 5, tambin se ejecutan los complementos
seleccionados. Si hay un error en alguno de los complementos, stos
pueden generar fallos de proteccin general en Visual Basic.
Para prevenir que ocurran este tipo de problemas, se pueden desactivar
los complementos editando el fichero VBAddin.INI que se encuentra en el
directorio WINDOWS. Al editar este fichero, aparecen entradas como la
siguiente:
AppWizard.Wizard=1
Cambie todos los "1" por "0" y grabe el fichero. Al ejecutar de nuevo VB
no se carga ningn complemento. Por supuesto, para aadir o quitar
complementos dentro de VB, se recomienda utilizar el Administrador de
complementos que se encuentra en el men Complementos.
Cmo limpiar las cajas de texto y otros controles de un formulario
necesario limpiar o inicializar todos los campos de un formulario. Si el
formulario contiene bastantes controles, esta tarea puede llegar a ser
tediosa. La siguiente rutina limpia de forma automtica el contenido de
cualquier campo en un formulario:
Public Sub LimpiarControles(frmForm _
As Form)
Dim ctlControl As Object
For Each ctlControl In frmForm.Controls
ctlControl.Text = ""
ctlControl.ListIndex = -1
DoEvents
Next ctlControl
End Sub
En el formulario llame a la funcin de la siguiente forma:
LimpiarControles Me
Cmo especificar la longitud mxima en un ComboBox
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits El control
ComboBox no tiene la propiedad MaxLength como una caja de texto. Sin
embargo, se puede aadir cdigo para simular esta propiedad. Por ejemplo,
pegue el siguiente cdigo en el evento KeyPress de un ComboBox:
Private Sub Combo1_KeyPress(KeyAscii As Integer)
Const MAXLENGTH = 10
If Len(Combo1.Text) >= MAXLENGTH And _
KeyAscii <> vbKeyBack Then
KeyAscii = 0
End Sub
Se puede cambiar la constante MAXLENGTH a cualquier valor que se desee.
Cmo mostrar un error de forma detallada al llamar a una API
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits La mayor parte
de las APIs de 32 bits retornan informacin detallada sobre el error
producido en caso de fallo. Para obtener esta informacin en un formato

adecuado y til, se pueden utilizar las funciones de la API GetLastError
y FormatMessage.
Aada el siguiente cdigo en un mdulo de proyecto (.BAS):
Option Explicit
Public Declare Function GetLastError _
Lib "kernel32" () As Long
Public Declare Function FormatMessage _
Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
Arguments As Long) As Long
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Function InformacionError() As String
Dim sError As String * 500
Dim lErrNum As Long
Dim lErrMsg As Long
lErrNum = GetLastError
lErrMsg = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
ByVal 0&, lErrNum, 0, sError, Len(sError), 0)
LastSystemError = Trim(sError)
End Function
Para comprobar si se produjo algn error al llamar a alguna API utilice
el siguiente cdigo:
MsgBox InformacionError
End Sub
Cmo comprobar la existencia de un fichero determinado
necesario saber si un fichero existe antes de utilizarlo y evitar futuros
problemas. La siguiente funcin muestra cmo verificar la existencia de
un fichero:
Public Sub VerificarFichero(_
sNombreFichero As String)
Open sNombreFichero For Input As #1
If Err Then
MsgBox ("El fichero " &_
sNombreFichero & " no existe.")
Exit Sub
End If
Close #1
End Sub
VerificarFichero "prueba.txt"
End Sub
Cmo mostrar colores degradados en un formulario de VB
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Se ha
preguntado alguna vez cmo se consigue el efecto de color producido en la
pantalla del SETUP.EXE?. Este efecto se denomina degradado o "dithering"
y puede ser fcilmente incorporado en sus formularios utilizando la
siguiente rutina:
Sub Degradado(vForm As Form)
Dim intContador As Integer
vForm.DrawStyle = vbInsideSolid
vForm.DrawMode = vbCopyPen
vForm.ScaleMode = vbPixels
vForm.DrawWidth = 2
vForm.ScaleHeight = 256
For intContador = 0 To 255
vForm.Line (0, intContador)-(Screen.Width, _
intContador - 1), RGB(0, 0, 255 - intContador), B
Next intContador
End Sub
Puede llamar a esta funcin desde el evento Paint del formulario. La
rutina muestra un color azul degradado aunque usted puede modificar el
color en la funcin RGB.
Si muestra un MsgBox sobre el formulario al que ha aplicado el degradado
y mueve la ventana de este MsgBox antes de cerrarla, puede observar
efectos extraos en el repintado del formulario. En este caso, se
recomienda simular el cuadro de mensaje con un formulario, en cuyo caso
el movimiento de la ventana no ocasiona ningn efecto colateral.
Cmo implementar la funcin "Deshacer" en una caja de texto
Aplicable a partir de Microsoft Visual Basic 4.0 Cuando se modifica el
contenido de una caja de texto, el sistema operativo Windows mantiene un
buffer con los datos aadidos o borrados. Se puede utilizar la funcin de
la API SendMessage para recuperar el texto modificado.
El mensaje EM_UNDO permite recuperar el texto modificado en una caja de
texto. El mensaje EM_EMPTYUNDOBUFFER vaca el buffer de "Deshacer". El
mensaje EM_CANUNDO devuelve True si hay texto en el buffer de "Deshacer".
A continuacin, se muestra un ejemplo:
Cree un nuevo proyecto en Visual Basic. Form1 es creado por

defecto.
Aada el siguiente cdigo a la seccin "Declaraciones" de Form1:

Private Declare Function SendMessage Lib _
"User" (ByVal hWnd As Integer, ByVal wMsg _
As Integer, ByVal wParam As Integer, _
lParam As Long) As Long
Const WM_USER = &H400
Const EM_CANUNDO = WM_USER + 22
Const EM_EMPTYUNDOBUFFER = _
WM_USER + 29
Const EM_UNDO = WM_USER + 23
Aada una caja de texto a Form1. Text1 es creado por defecto.

Establezca su propiedad MultiLine a True.
Aada un botn a Form1. Command1 es creado por defecto. Establezca

su propiedad Caption a "Undo".
Aada el siguiente cdigo al evento Click de Command1:

Dim OK As Long
OK = SendMessage(Text1.hWnd, _
EM_UNDO, 0, 0&)
EM_EMPTYUNDOBUFFER, 0, 0&)
End Sub
Aada un segundo botn a Form1. Command2 es creado por defecto.

Establezca su propiedad Caption a "Redo".
Aada el siguiente cdigo al evento Click de Command2:

Dim OK As Long
EM_CANUNDO, 0, 0&)
If OK = 0 Then
MsgBox "No puedo deshacer los cambios", _
16, "Error"
End If
EM_UNDO, 0, 0&)
End Sub
Cmo determinar qu fuentes estn instaladas en el sistema
Aplicable a partir de Microsoft Visual Basic 4.0 La coleccin Fonts de
los objetos Screen y Printer proporcionan una lista de todas las fuentes
instaladas en el sistema operativo. El siguiente ejemplo muestra cmo
recuperar las fuentes de pantalla e impresora instaladas:
Cree un nuevo proyecto en Visual Basic. Por defecto, se crea el

formulario Form1.
Aada un control Listbox al Form1. Por defecto, la lista tiene el

nombre List1.
Aada un botn tipo Command al Form1. Por defecto, el botn tiene

el nombre Command1.
Aada un segundo botn tipo Command al Form1. Por defecto, el

botn tiene el nombre Command2.
Aada el siguiente cdigo al evento Click de Command1.

List1.Clear
Dim X As Integer
For X = 0 To Printer.FontCount - 1
List1.AddItem Printer.Fonts(X)
Next X
End Sub
Aada el siguiente cdigo al evento Click de Command2.

List1.Clear
Dim X As Integer
For X = 0 To Screen.FontCount - 1
List1.AddItem Screen.Fonts(X)
Next X
End Sub
Cmo obtener el nombre corto (MS-DOS) a partir del nombre largo de un
fichero.
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits La API de 32
bits GetShortPathName obtiene el nombre corto de un fichero (formato 8.3)
a partir de su nombre largo. Haga la prueba con el siguiente ejemplo:
Cree un nuevo proyecto en Visual Basic. Por defecto, se crea el

formulario Form1.
Aada un botn tipo Command al Form1. Por defecto, el botn tiene

el nombre Command1.
Aada el siguiente cdigo al evento Click del Command1:

Dim sNombreCorto As String * 255
GetShortPathName "C:\Archivos de _
programa\Accesorios\Wordpad.exe",_
sNombreCorto, 255
MsgBox sNombreCorto
End Sub
Aada el siguiente cdigo en la seccin Declaraciones del Form1:

Private Declare Function GetShortPathName Lib _
"kernel32" Alias "GetShortPathNameA" (ByVal _
lpszLongPath As String, ByVal lpszShortPath As _
String, ByVal cchBuffer As Long) As _
Long
Cmo reproducir un CD de audio
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Desde Visual
Basic se puede reproducir un CD de audio mediante el uso de MCI, como se
muestra en el siguiente ejemplo para VB 16 bits:
'Introduzca en un formulario un MMControl _
(Multimedia Control)
Declare Function mciSendString& Lib _
"MMSYSTEM" (ByVal lpstrCommand$, _

ByVal lpstrReturnStr As Any, ByVal _
wReturnLen%, ByVal hCallBack%)
Sub cmdPlay_Click ()
Dim Resultado As Long
Dim PistaActual As Integer
'Apertura del dispositivo
Resultado = mciSendString( _
"open cdaudio alias cd wait", _
0&, 0, 0)
'Establecer formato de tiempo en pistas
Resultado = mciSendString("set cd time _
format tmsf", 0&, 0, 0)
'Comenzar desde el principio
Resultado = mciSendString("play cd", 0&, 0, 0)
'O reproducir por ejemplo la pista 4
PistaActual = 4
resultado = mciSendString("play cd from" & _
Str (PistaActual) , 0&, 0, 0)
End Sub
Sub cmdStop_Click ()
Dim lRet As Long
'Parar reproduccin
lRet = mciSendString("stop cd wait", 0&, 0, 0)
DoEvents 'Procesar evento
'Cerrar dispositivo
lRet = mciSendString("close cd", 0&, 0, 0)
End Sub
Cmo saber si un ejecutable es de Windows o MS-DOS
Aplicable a todas las versiones
Para saber si un ejecutable es de MS-DOS o Windows, se debe examinar el
byte nmero 25 del fichero EXE. Si contiene el valor 40h es un ejecutable
de Windows:
Function WinExe (ByVal Exe As String) As Integer
Dim fh As Integer
Dim t As String * 1
fh = FreeFile
Open Exe For Binary As #fh
Get fh, 25, t
Close #fh
WinExe = (Asc(t) = &H40&)
End Function
Cmo enviar un fichero de Windows 95 a la papelera
Aplicable a las versiones 4.0/32 bits y 5.0
Las aplicaciones de 32-bit pueden llamar a la funcin SHFileOperation de

la API de Windows para enviar un fichero a la papelera de reciclaje de
Windows95. El siguiente ejemplo muestra cmo utilizar esta funcin y la
instruccin ParamArray de VB:
Option Explicit
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Declare Function SHFileOperation _
Lib "shell32.dll" Alias _
"SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Public Function BorrarFichero(ParamArray _
vntNombreFichero() As Variant) As Long
Dim I As Integer
Dim sNombreFicheros As String
Dim SHOpFichero As SHFILEOPSTRUCT
For I = LBound(vntNombreFichero) To _
UBound(vntNombreFichero)
sNombreFicheros = sNombreFicheros & _
vntNombreFichero(I) & vbNullChar
Next
sNombreFicheros = sNombreFicheros & vbNullChar
With SHOpFichero
.wFunc = FO_DELETE
.pFrom = sNombreFicheros
.fFlags = FOF_ALLOWUNDO
End With
BorrarFichero = _
SHFileOperation(SHOpFichero)
End Function
El argumento ParamArray permite pasar cualquier nmero de ficheros a la
funcin:
' Borrado de un nico fichero
Resultado = BorrarFichero("BORRA.ME")
' Borrado de varios ficheros
Resultado = BorrarFichero("BORRA.ME", _
PRUEBA1.DOC", "PRUEBA2.TXT")
Cmo crear accesos directos -shortcuts- en Windows 95 desde Visual Basic
Aplicable a partir de Microsoft Visual Basic 4.0 32 bits La librera
STKIT432.DLL que Visual Basic 4.0 instala en el directorio SYSTEM de
WINDOWS, incluye la siguiente funcin para crear accesos directos en el
men inicio de Windows 95.
Declare Function fCreateShellLink Lib "STKIT432.DLL" _
(ByVal lpstrFolderName As String, _

ByVal lpstrLinkName As String, _
ByVal lpstrLinkPath As String, _
ByVal lpstrLinkArgs As String) As Long
Esta funcin se puede utilizar para crear un acceso directo en cualquier
lugar del disco.
El primer parmetro de la funcin (lpstrFolderName) es relativo a la
carpeta Programas del Men de Inicio. Esto quiere decir que si se pasa un
cadena nula como primer parmetro, el acceso directo ser creado en la
propia carpeta de Programas. De igual manera, se puede navegar desde la
carpeta de Programas a cualquier directorio del disco duro. Por ejemplo,
el siguiente cdigo crear un acceso directo en el escritorio del
usuario:
Resultado = fCreateShellLink _
("..\..\Escritorio", "Bloc de_
notas", "c:\windows\notepad.exe", "")
Como crear un grupo de programas:
Muy til para crear instalaciones por ejemplo:
Aadir un textbox y hacerlo oculto.
Una vez oculto, escribir estas lneas sustituyendo "Nombre del Grupo" por
que que se desea crear, y que lo colocamos en Inicio -> Programas.
Text1.LinkTopic = "Progman|Progman"
Text1.LinkMode = 2
Text1.LinkExecute "[CreateGroup(" + "Nombre del Grupo" + ")]"
End Sub
Vaciar la carpeta de Documentos de Windows:
Inicie un nuevo proyecto y aada el siguiente cdigo:
Private Declare Function SHAddToRecentDocs Lib "Shell32"
(ByVal lFlags As Long, ByVal lPv As Long) As Long
SHAddToRecentDocs 0, 0
End Sub
Abrir la ventana de Propiedades de agregar o quitar aplicaciones:
Aada el siguiente cdigo:
X = Shell("Rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl @0")
End Sub
Uso de Random:
La funcin Rnd o Random posee la virtud de obtener nmeros aleatorios
entre 0 y 1:
El nico inconveniente a la hora de usar Rnd, es que hay que
inicializarlo, en otro caso, el resultado de la funcin Rnd, ser siempre
el mismo dentro de un determinado ordenador. Por ejemplo, el cdigo:
Dim Num As Double
Num = Rnd
MsgBox Num
End Sub
Nos dara como resultado siempre el mismo nmero.
Para solucionar este problema, debemos escribir la sentencia Randomize
antes de llamar a la funcin Rnd. De esta manera, la funcin Rnd actuar
correctamente.
El cdigo quedara as:
Dim Num As Double
Randomize
Num = Rnd
MsgBox Num
End Sub
Calcular la etiqueta o label de un disco duro:
Hallar la etiqueta o label del mismo disco duro:
Escribir el siguiente cdigo:

Private Declare Function GetVolumeInformation& Lib "kernel32" Alias
"GetVolumeInformationA" (ByVal lpRootPathName As String,
ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long,
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long,
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String,
ByVal nFileSystemNameSize As Long)
Dim cad1 As String * 256
Dim cad2 As String * 256
Dim numSerie As Long
Dim longitud As Long
Dim flag As Long
unidad = "D:\"
Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud,
flag, cad2, 256)
MsgBox "Label de la unidad " & unidad & " = " & cad1
End Sub
Imprimir un RichTextBox tal y como se ve:
Imprimir un RichTextBox con su formato original.
On Error GoTo ErrorDeImpresion
Printer.Print ""
RichTextBox1.SelPrint Printer.hDC
Printer.EndDoc
Exit Sub
ErrorDeImpresion:
Exit Sub
End Sub
Otra forma:
En el Formulario [Form1 por defecto] :
Dim LineWidth As Long
Me.Caption = "Rich Text Box Ejemplo de Impresion"
Command1.Move 10, 10, 600, 380
Command1.Caption = "&Imprimir"
RichTextBox1.SelFontName = "Arial"
RichTextBox1.SelFontSize = 10
LineWidth = WYSIWYG_RTF(RichTextBox1, 1440, 1440)
Me.Width = LineWidth + 200
End Sub
Private Sub Form_Resize()
RichTextBox1.Move 100, 500, Me.ScaleWidth - 200, Me.ScaleHeight 600
End Sub
PrintRTF RichTextBox1, 1440, 1440, 1440, 1440
End Sub
Crear un mdulo y escribir:
Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type CharRange
cpMin As Long
cpMax As Long
End Type
Private Type FormatRange
hdc As Long
hdcTarget As Long
rc As Rect
rcPage As Rect
chrg As CharRange
End Type
Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As
Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
Public Function WYSIWYG_RTF(RTF As RichTextBox, LeftMarginWidth As Long,
_
RightMarginWidth As Long) As Long
Dim LeftOffset As Long, LeftMargin As Long, RightMargin As Long
Dim LineWidth As Long
Dim PrinterhDC As Long
Dim r As Long
Printer.Print Space(1)
Printer.ScaleMode = vbTwips
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETX), vbPixels, vbTwips)
LeftMargin = LeftMarginWidth - LeftOffset
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
LineWidth = RightMargin - LeftMargin
PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
r = SendMessage(RTF.hWnd, EM_SETTARGETDEVICE, PrinterhDC, _
ByVal LineWidth)
Printer.KillDoc
WYSIWYG_RTF = LineWidth
End Function
Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
TopMarginHeight, RightMarginWidth, BottomMarginHeight)
Dim LeftOffset As Long, TopOffset As Long
Dim LeftMargin As Long, TopMargin As Long
Dim RightMargin As Long, BottomMargin As Long
Dim fr As FormatRange
Dim rcDrawTo As Rect
Dim rcPage As Rect
Dim TextLength As Long
Dim NextCharPosition As Long
Dim r As Long
Printer.ScaleMode = vbTwips
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETX), vbPixels, vbTwips)
TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETY), vbPixels, vbTwips)
LeftMargin = LeftMarginWidth - LeftOffset
TopMargin = TopMarginHeight - TopOffset
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight
rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
fr.rc = rcDrawTo
fr.rcPage = rcPage
fr.chrg.cpMin = 0
fr.chrg.cpMax = -1
TextLength = Len(RTF.Text)
Do
NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr)
If NextCharPosition >= TextLength Then Exit Do
fr.chrg.cpMin = NextCharPosition
Printer.NewPage
fr.hDC = Printer.hDC
fr.hDCTarget = Printer.hDC
Loop
Printer.EndDoc
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0))
End Sub
Como obtener el directorio desde donde estamos ejecutando nuestro
programa:
Dim Directorio as String
ChDir App.Path
ChDrive App.Path
Directorio = App.Path
If Len(Directorio) > 3 Then
Directorio = Directorio & "\"
End If
End Sub
Determinar si un fichero existe o no:
Escriba el siguiente cdigo: (una de tanta maneras aparte de Dir$())
On Error GoTo Fallo
x = GetAttr("C:\Autoexec.bat")
MsgBox "El fichero existe."
Exit Sub
Fallo:
MsgBox "El fichero no existe."
End Sub
Capturar la pantalla entera o la ventana activa:
Aadir dos botones y escribir el siguiente cdigo:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte,
ByVal bScan As Byte, ByVal dwFlags As Long,
ByVal dwExtraInfo As Long)
'Captura la ventana activa
keybd_event 44, 0, 0&, 0&
End Sub
'Captura toda la pantalla
keybd_event 44, 1, 0&, 0&
End Sub
Salvar el contenido de un TextBox a un fichero en disco:
Aada el siguiente cdigo:
Dim canalLibre As Integer
'Obtenemos un canal libre que nos dar

'el sistema oparativo para poder operar
canalLibre = FreeFile
'Abrimos el fichero en el canal dado
Open "C:\fichero.txt" For Output As #canalLibre
'Escribimos el contenido del TextBox al fichero
Print #canalLibre, Text1
Close #canalLibre
End Sub
Como desplegar la lista de un ComboBox automticamente:
Insertar un ComboBox y un Botn en un nuevo proyecto y escribir el
siguiente cdigo:
Private Declare Function SendMessageLong Lib "user32" Alias
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,
ByVal wParam As Long, ByVal lParam As Long) As Long
Combo1.Clear
Combo1.AddItem "Objeto 1"
Combo1.Text = "Objeto 1"
End Sub
'ComboBox desplegado
Dim Resp As Long
Resp = SendMessageLong(Combo1.hwnd, &H14F, True, 0)
End Sub
Nota: Resp = SendMessageLong(Combo1.hwnd, &H14F, False, 0) oculta la
lista desplegada de un ComboBox, aunque esto sucede tambin cuando
cambiamos el focus a otro control o al formulario.
Seleccin y eliminacin de todos los elementos de un ListBox:
Insertar un ListBox y dos Botn en un nuevo proyecto. Poner la propiedad
MultiSelect del ListBox a "1 - Simple" y escriba el siguiente cdigo:
Private Declare Function SendMessageLong Lib "user32" Alias
ByVal wParam As Long, ByVal lParam As Long) As Long
List1.AddItem "Texto 1"
End Sub
'Seleccion de todo el contenido
Dim Resp As Long
Resp = SendMessageLong(List1.hwnd, &H185&, True, -1)
End Sub
'Eliminacion de todos los elementos seleccionados
Dim Resp As Long
Resp = SendMessageLong(List1.hwnd, &H185&, False, -1)
End Sub
Calcular el tamao de fuentes de letra:
Es til para utilizar con la propiedad Resize sobre los controles al
cambiar de resolucin de pantalla.

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal
hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd
As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" ()
As Long
Dim ObCaps As Long
Dim ObDC As Long
Dim ObDesktop As Long
Dim Cad As String
ObDesktop = GetDesktopWindow()
ObDC = GetDC(ObDesktop)
ObCaps = GetDeviceCaps(ObDC, 88)
If ObCaps = 96 Then Cad = "Pequeas
If ObCaps = 120 Then Cad = "Grandes"
MsgBox "Fuentes de letra " & Cad
End Sub
*) Esta funcin ha sido corregida por un error en las etiquetas, 96
corresponde a pequeas y 120 a Grandes, agradecimientos a Andrs Moral
Gutirrez por su correcin (01/06/1998)
Provocar la trasparencia de un formulario:
Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long,
ByVal dwNewLong As Long) As Long
Dim Resp As Long
Resp = SetWindowLong(Me.hwnd, -20, &H20&)
Form1.Refresh
End Sub
Pasar de un TextBox a otro al pulsar Enter:
Insertar tres TextBox y escribir el siguiente cdigo:
Private Sub Text1_KeyPress(KeyAscii As Integer)
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
otra forma:
Insertar tres TextBox, cambiar la propiedad KeyPreview del formulario a
True y escribir el siguiente cdigo:
Private Sub Form_KeyPress(KeyAscii As Integer)
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Usar IF THEN ELSE ENDIF en una misma lnea:
Insertar un CommandButton y un TextBox y escribir el siguiente cdigo:

Dim I As Integer
Dim A As String
I = 3
A = IIf(I <> 1, "True", "False")
Text1.Text = A
End Sub
Convertir un texto a maysculas o minsculas:
Crear un formulario y situar un TextBox. Escribir:
Private Sub Text1_Change()
Dim I As Integer
Text1.Text = UCase(Text1.Text)
I = Len(Text1.Text)
Text1.SelStart = I
End Sub
Presentar la ventana AboutBox (Acerca de) por defecto:
Escribir el siguiente cdigo en el formulario:
Private Declare Function ShellAbout Lib "shell32.dll" Alias
"ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String,
ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Call ShellAbout(Me.hwnd, "Ttulo Programa", "Copyright 1997, Dueo de la
aplicacin", Me.Icon)
End Sub
Incrementar un men en ejecucin:
Abrir un proyecto nuevo, y haga doble click sobre el formulario. Meidante
el gestr de mens escribir lo siguiente:
Caption -> Editor
Name -> MnuEditor
Pulse Insertar y el botn "->"
Caption -> Aadir
Name -> MnuAadir
Pulse Insertar
Caption -> Quitar
Name -> MnuQuitar
Enabled -> False
Pulse Insertar
Caption -> Salir
Name -> MnuSalir
Pulse Insertar
Caption -> Name -> MnuIndex
Index -> 0
Pulse Aceptar
Escribir el siguiente cdigo en el formulario:
Private ultElem As Integer
ultElem = 0
End Sub
Private Sub MnuQuitar_Click()
Unload MnuIndex(ultElem)
ultElem = ultElem - 1
If ultElem = 0 Then
MnuQuitar.Enabled = False
End If
End Sub
Private Sub MnuSalir_Click()
End
End Sub
Private Sub MnuAadir_Click()
ultElem = ultElem + 1
Load MnuIndex(ultElem)
MnuIndex(ultElem).Caption = "Menu -> " + Str(ultElem)
MnuQuitar.Enabled = True
End Sub
Cambiar el fondo de Windows desde Visual Basic:
Crear un formulario y escribir:
Private Declare Function SystemParametersInfo Lib "user32" Alias
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As
Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Dim fallo As Integer
fallo = SystemParametersInfo(20, 0, "C:\WINDOWS\FONDO.BMP", 0)
End Sub
Calcular el nmero de colores de video del modo actual de Windows:
Crear un formulario y un TextBox y escribir:
Private Declare Function GetDeviceCaps Lib "gdi32"
(ByVal hdc As Long, ByVal nIndex As Long) As Long
i = (2 ^ GetDeviceCaps(Form1.hdc, 12)) ^
GetDeviceCaps(Form1.hdc, 14)
Text1.Text = CStr(i) & " colores."
End Sub
Ajustar un Bitmap a la pantalla:
Crear un formulario con un BitMap cualquiera y una etiqueta o Label con
los atributos que quiera.
Escribir lo siguiente:
Private Sub Form_Paint()
Dim i As Integer
For i = 0 To Form1.ScaleHeight Step Picture1.Height
For j = 0 To Form1.ScaleWidth Step Picture1.Width
PaintPicture Picture1, j, i, Picture1.Width,
Picture1.Height
Next
Next
End Sub
Private Sub Form_Resize()
Picture1.Left = -(Picture1.Width + 200)
Picture1.Top = -(Picture1.Height + 200)
Label1.Top = 100
Label1.Left = 100
End Sub
Detectar la unidad del CD-ROM:
Si para instalar una aplicacin o ejecutar un determinado software
necesitas saber si existe el CD-ROM:.
Crear un formulario con una etiqueta y escribir lo siguiente:
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias
"GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal
lpBuffer As String) As Long
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Function StripNulls(startStrg$) As String
Dim c%, item$
c% = 1
Do
If Mid$(startStrg$, c%, 1) = Chr$(0) Then
item$ = Mid$(startStrg$, 1, c% - 1)
startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$))

StripNulls$ = item$
Exit Function
End If
c% = c% + 1
Loop
End Function
Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
Dim CDfound As Integer
allDrives$ = Space$(64)
r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
allDrives$ = Left$(allDrives$, r&)
Do
pos% = InStr(allDrives$, Chr$(0))
If pos% Then
JustOneDrive$ = Left$(allDrives$, pos%)
allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
DriveType& = GetDriveType(JustOneDrive$)
If DriveType& = DRIVE_CDROM Then
CDfound% = True
Exit Do
End If
End If
Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM
If CDfound% Then
label1.Caption = "La unidad de CD-ROM corresponde a la
unidad: " & UCase$(JustOneDrive$)
Else
label1.Caption = "Su sistema no posee CD-ROM o unidad
no encontrada."
End If
End Sub
Calcular la profundidad de color (bits por pixel) y resolucin de
Windows:
Crear un formulario y un TextBox y escribir:
Private Declare Function GetDeviceCaps Lib "gdi32"
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Dim col, bit, largo, alto As Integer
col = GetDeviceCaps(Form1.hdc, 12)
If col = 1 Then
bit = GetDeviceCaps(Form1.hdc, 14)
If bit = 1 Then
Text1.Text = "Resolucion de 1 bit / 2 colores"
ElseIf bit = 4 Then
Text1.Text = "Resolucion de 4 bits / 16 colores"
End If
ElseIf col = 8 Then
ElseIf col = 16 Then
Else
Text1.Text = "Resolucion de 16 M colores"
End If
largo = GetDeviceCaps(Form1.hdc, 8)
alto = GetDeviceCaps(Form1.hdc, 10)
Text1.Text = Text1.Text & " " & largo & "x" & alto & " pixels"
End Sub
Comprobar si el sistema posee tarjeta de sonido:
Private Declare Function waveOutGetNumDevs Lib
"winmm.dll" () As Long
Dim inf As Integer
inf = waveOutGetNumDevs()
If inf > 0 Then
MsgBox "Tarjeta de sonido soportada.", vbInformation,
"Informacion: Tarjeta de sonido"
Else
MsgBox "Tarjeta de sonido no soportada.", vbInformation,
"Informacion: Tarjeta de sonido"
End If
End
End Sub
Crear una ventana con la informacin del Sistema:
Crear un formulario e insertar un mdulo y escribir en el formulario lo
siguiente:
Dim msg As String
MousePointer = 11
Dim verinfo As OSVERSIONINFO
verinfo.dwOSVersionInfoSize = Len(verinfo)
ret% = GetVersionEx(verinfo)
If ret% = 0 Then
MsgBox "Error Obteniendo Information de la Version"
End
End If
Select Case verinfo.dwPlatformId
Case 0
msg = msg + "Windows 32s "
Case 1
msg = msg + "Windows 95 "
Case 2
msg = msg + "Windows NT "
End Select
ver_major$ = verinfo.dwMajorVersion
ver_minor$ = verinfo.dwMinorVersion
build$ = verinfo.dwBuildNumber
msg = msg + ver_major$ + "." + ver_minor$
msg = msg + " (Construido " + build$ + ")" + vbCrLf + vbCrLf
Dim sysinfo As SYSTEM_INFO
GetSystemInfo sysinfo
msg = msg + "CPU: "
Select Case sysinfo.dwProcessorType
Case PROCESSOR_INTEL_386
msg = msg + "Procesador Intel 386 o compatible." + vbCrLf
Case PROCESSOR_INTEL_486
msg = msg + "Procesador Intel 486 o compatible." + vbCrLf
Case PROCESSOR_INTEL_PENTIUM
msg = msg + "Procesador Intel Pentium o compatible." + vbCrLf
Case PROCESSOR_MIPS_R4000
msg = msg + "Procesador MIPS R4000." + vbCrLf
Case PROCESSOR_ALPHA_21064
msg = msg + "Procesador DEC Alpha 21064." + vbCrLf
Case Else
msg = msg + "Procesador (desconocido)." + vbCrLf
End Select
msg = msg + vbCrLf
Dim memsts As MEMORYSTATUS
Dim memory&
GlobalMemoryStatus memsts
memory& = memsts.dwTotalPhys
msg = msg + "Memoria Fisica Total: "
msg = msg + Format$(memory& \ 1024, "###,###,###")

memory& = memsts.dwAvailPhys
msg = msg + "Memoria Fisica Disponible: "
memory& = memsts.dwTotalVirtual
msg = msg + "Memoria Virtual Total: "
memory& = memsts.dwAvailVirtual
msg = msg + "Memoria Virtual Disponible: "
vbCrLf
MsgBox msg, 0, "Acerca del Sistema"
MousePointer = 0
End
End Sub
Escribir lo siguiente en el mdulo:
Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Declare Function GetVersionEx Lib "kernel32"
Alias "GetVersionExA" (LpVersionInformation
As OSVERSIONINFO) As Long
Declare Sub GlobalMemoryStatus Lib "kernel32"
(lpBuffer As MEMORYSTATUS)
Declare Sub GetSystemInfo Lib "kernel32"
(lpSystemInfo As SYSTEM_INFO)
Public Const PROCESSOR_INTEL_386 = 386
Public Const PROCESSOR_INTEL_486 = 486
Public Const PROCESSOR_INTEL_PENTIUM = 586
Public Const PROCESSOR_MIPS_R4000 = 4000
Public Const PROCESSOR_ALPHA_21064 = 21064
Mostrar un fichero AVI a pantalla completa:
Private Declare Function mciSendString Lib
"winmm.dll" Alias "mciSendStringA"
(ByVal lpstrCommand As String,
+ "Kb" + vbCrLf
+ "Kb" + vbCrLf
+ "Kb" + vbCrLf
+ "Kb" + vbCrLf +
ByVal lpstrReturnString As Any,

ByVal uReturnLength As Long,
ByVal hwndCallback As Long) As Long
CmdStr$ = "play e:\media\avi\nombre.avi fullscreen"
ReturnVal& = mciSendString(CmdStr$, 0&, 0, 0&)
End Sub
Crear un link con un programa aadindolo al grupo de programas situado
en
Inicio -> Programas o Start -> Programs:
Private Declare Function fCreateShellLink
Lib "STKIT432.DLL" (ByVal lpstrFolderName
As String, ByVal lpstrLinkName As String,
ByVal lpstrLinkPath As String,
ByVal lpstrLinkArgs As String) As Long
iLong = fCreateShellLink("",
"Visual Basic", "C:\Archivos de Programa\DevStudio\Vb\vb5.exe", "")
End Sub
Apagar el equipo, reiniciar Windows, reiniciar el Sistema:
Aadir tres botones a un formulario y escribir lo siguiente en el cdigo
del formulario:
Private Declare Function ExitWindowsEx& Lib "user32" (ByVal
uFlags&, ByVal dwReserved&)
Dim i as integer
i = ExitWindowsEx(1, 0&) 'Apaga el equipo
End Sub
Dim i as integer
i = ExitWindowsEx(0, 0&) 'Reinicia Windows con nuevo usuario
End Sub
Dim i as integer
i = ExitWindowsEx(2, 0&) 'Reinicia el Sistema
End Sub
Borrar un fichero y enviarlo a la papelera de reciclaje:
Crear un formulario y escribir el siguiente cdigo:
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Sub PapeleraDeReciclaje(ByVal Fichero As String)
Dim SHFileOp As SHFILEOPSTRUCT
Dim RetVal As Long
With SHFileOp
.wFunc = FO_DELETE
.pFrom = FileName
End With
RetVal = SHFileOperation(SHFileOp)
End Sub
Recycle "c:\a.txt"
End Sub
El programa preguntar si deseamos o no eliminar el fichero y enviarlo a
la papelera de reciclaje. El parmetro .fFlags nos permitir recuperar el
fichero de la papelera si lo deseamos. Si eliminamos esta lnea, el
fichero no podr ser recuperado.
Abrir el Acceso telefnico a Redes de Windows y ejecutar una conexin:
Dim AbrirConexion As Long
AbrirConexion = Shell("rundll32.exe rnaui.dll,RnaDial " &
"ConexinInternet", 1)
SendKeys "{ENTER}"
End Sub
Situar una ScroolBar horizontal en un ListBox:
Private Declare Function SendMessage Lib "user32" Alias
ByVal wParam As Long, lParam As Any) As Long
Dim x As Integer, i As Integer
For i = 1 To 20
List1.AddItem "El nmero final de la seleccin es el " & i
Next i
x = SendMessage(List1.hwnd, &H194, 200, ByVal 0&)
End Sub
Forzar a un TextBox para que admita nicamente nmeros:
Crear un formulario, aadir un TextBox y escribir el siguiente cdigo:
Sub Text1_Keypress(KeyAscii As Integer)
If KeyAscii <> Asc("9") Then
'KeyAscii = 8 es el retroceso o BackSpace
If KeyAscii <> 8 Then
KeyAscii = 0
End If
End If
End Sub
Forzar a un InputBox para que admita nicamente nmeros:
Dim Numero As String
Do
Numero = InputBox("Introduzca un numero:")
Loop Until IsNumeric(Numero)
MsgBox "El numero es el " & Numero
Unload Me
End Sub
Hacer Drag & Drop de un control (ejemplo de un PictureBox):
En un formulario, aadir un PictureBox con una imagen cualquiera y
escribir el siguiente cdigo:
Private DragX As Integer
Private DragY As Integer
Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move (X - DragX), (Y - DragY)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer,
X As Single, Y As Single)
'Si el boton del raton es el derecho, no hacemos nada
If Button = 2 Then Exit Sub
Picture1.Drag 1
DragX = X
DragY = Y
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Picture1.Drag 2
End Sub
Centrar una ventana en Visual Basic:
Usar:
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
En vez de:
Form1.Left = Screen.Width - Width \ 2
Form1.Top = Screen.Height - Height \ 2
Ejecuta pausas durante un determinado espacio de tiempo en segundos:
Llamada: Espera(5)
Sub Espera(Segundos As Single)
Dim ComienzoSeg As Single
Dim FinSeg As Single
ComienzoSeg = Timer
FinSeg = ComienzoSeg + Segundos
Do While FinSeg > Timer
DoEvents
If ComienzoSeg > Timer Then
FinSeg = FinSeg - 24 * 60 * 60
End If
Loop
End Sub
Editor de texto:
Seleccionar todo el texto:
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Copiar texto:
Clipboard.Clear
Clipboard.SetText Text1.SelText
Text1.SetFocus
Pegar texto:
Text1.SelText = Clipboard.GetText()
Text1.SetFocus
Cortar texto:
Clipboard.SetText Text1.SelText
Text1.SelText = ""
Text1.SetFocus
Deshacer texto: (Nota: esta operacin slo es eficaz con el control Rich
TextBox).
En un mdulo copie esta lnea:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long)
As Long
Esta es la instruccin de la funcin deshacer:
UndoResultado = SendMessage(Text1.hwnd, &HC7, 0&, 0&)
If UndoResultado = -1 Then
Beep
MsgBox "Error al intentar recuperar.", 20, "Deshacer texto"
End If
Seleccionar todo el texto:
SendKeys "^A"
Copiar texto:
SendKeys "^C"
Pegar texto:
SendKeys "^V"
Cortar texto:
SendKeys "^X"
Deshacer texto:
SendKeys "^Z"
Obtener el directorio de Windows y el directorio de Sistema:
En un mdulo copiar estas lneas:
Declare Function GetSystemDirectory Lib "kernel32" Alias
"GetSystemDirectoryA"_
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias
"GetWindowsDirectoryA"_
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Ponga dos Labels o etiquetas y un botn en el formulario:
Label1, Label2, Command1
Hacer doble click sobre el botn y escribir el cdigo siguiente:
Dim Car As String * 128
Dim Longitud, Es As Integer
Dim Camino As String
Longitud = 128
Es = GetWindowsDirectory(Car, Longitud)
Camino = RTrim$(LCase$(Left$(Car, Es)))
Label1.Caption = Camino
Es = GetSystemDirectory(Car, Longitud)
Camino = RTrim$(LCase$(Left$(Car, Es)))
Label2.Caption = Camino
End Sub
Ocultar la barra de tareas en Windows 95 y/o Windows NT:
En un mdulo copiar estas lneas:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName_
As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal
hWndInsertAfter
As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As
Long,_
ByVal wFlags As Long) As Long
Global Ventana As Long
Global Const Muestra = &H40
Global Const Oculta = &H80
En un formulario ponga dos botones y escriba el cdigo correspondiente
a cada uno de ellos:
'Oculta la barra de tareas
Ventana = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta)
End Sub
'Muestra la barra de tareas
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra)
End Sub
Cambiar rpidamente la propiedad Enabled
La propiedad Enabled de un objeto se puede alternar fcilmente con una
nica lnea de cdigo:
optAlternar.Enabled = NOT optAlternar.Enabled
Este cdigo es independiente de la definicin de True y False, la cual
vara segn la versin de VB utilizada. Ya sea que se represente
numricamente (-1 = True; 0 = False) o lgicamente, la operacin NOT se
adapta para dar el resultado correcto.
Evitar el "beep" del [ENTER]
Muchas veces, cuando se ingresa informacin en una caja de texto y se

presiona la tecla [ENTER], se escucha un "beep". Para evitar esto,
colocar el cdigo siguiente en el evento KeyPress de la caja de texto:
If KeyAscii = Asc(vbCR) Then
KeyAscii = 0
End If
TextBox de slo lectura
Para hacer que un TextBox sea de slo lectura, podemos setear su
propiedad Enabled a False. Sin embargo, esto le da un feo color gris que
habitualmente dificulta. Otra manera de hacerlo, ms elegante, es incluir
el siguiente cdigo en el evento KeyPress de dicho control (el cual no
impide que el usuario coloque el cursor sobre l):
KeyAscii = 0
Cantidad de Bytes que Ocupa un Directorio
Sub Form_Load()
Dim FileName As String
Dim FileSize As Currency
Dim Directory As String
Directory = "c:\windows\"
FileName = Dir$(Directory & "*.*")
FileSize = 0
Do While FileName <> ""
FileSize = FileSize + FileLen(Directory & FileName)
FileName = Dir$
Loop
Text1.Text = "Este directorio ocupa la cantidad de bytes = " +
Str$(FileSize)
End Sub
Cantidad de Bytes que Ocupa un Directorio
Sub Form_Load()
Dim FileName As String
Dim FileSize As Currency
Dim Directory As String
Directory = "c:\windows\"
FileName = Dir$(Directory & "*.*")
FileSize = 0
Do While FileName <> ""
FileSize = FileSize + FileLen(Directory & FileName)
FileName = Dir$
Loop
Text1.Text = "Este directorio ocupa la cantidad de bytes = " +
Str$(FileSize)
End Sub
Una ventana con forma ELIPTICA !!!???
Solamente necesitamos declarar en un Modulo lo siguiente:
Public Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn"
(ByVal hWnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" Alias
"CreateEllipticRgn" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As
Long
En el evento click de la ventana:
Dim Xs as Long, Ys as Long
Xs = Me.Width / Screen.TwipsPerPixelX
Ys = Me.Height / Screen.TwipsPerPixelY
SetWindowRgn hWnd, CreateEllipticRng(0, 0, Xs, Ys), True
End Sub
Centrar una Ventana
Para Centrar una ventana en el medio de la pantalla, colocar el siguiente
codigo en el evento Load de un Form:
Me.Move (Sreen.Width - Me.Width) / 2, Me.Move (Screen.Height - Me.Height)
/ 2
Enviar Faxes Utilizando los controles de VB
Utilizaremos para ello los controles MAPI Messages y MAPI Session para
crear un mensaje de Exchange.
Si en el campo de la direccin e-mail empiezas por "Fax: " y continuas
con el n de fax, conseguirs enviar el mensaje a travs del servicio MS
Fax.
Ten cuidado de utilizar un perfil de Exchange que solo incluya el
servicio Fax, no el Internet Mail, porque si no intentar enviarlo por
los dos sistemas.
MAPISession1.LogonUI = False
wPerfil = "Configuraciones de MS Exchange"
MAPISession1.UserName = wPerfil
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
Sesion = True
lblEstado = "Creando mensaje..."
MAPIMessages1.ComposeMAPIMessages1.MsgSubject = ""
' No utilizar el campo de texto. Lo intenta imprimir con el Word como
' segunda hoja y falla dando error WordBasic n 124 (teniendo instalado
el Parche)
MAPIMessages1.MsgNoteText = "Este es el texto de la prueba....."
MAPIMessages1.RecipIndex = 0
MAPIMessages1.RecipIndex = NumDestino
MAPIMessages1.RecipType = mapToList
MAPIMessages1.RecipDisplayName = Data1.Recordset.Fields(1)
MAPIMessages1.RecipAddress = "Fax:" & Data1.Recordset.Fields(0)
MAPIMessages1.AttachmentIndex = I
MAPIMessages1.AttachmentPosition = I
MAPIMessages1.AttachmentPathName = wPath
MAPIMessages1.AttachmentName = wName
lblEstado = "Enviando mensaje..."
MAPIMessages1.Send
MAPISession1.SignOff
Encriptacion XOR
El operador lgico XOR suministra un interesante algoritmo de
encriptacin, se codifica en la primera llamada y se decodifica en la
segunda. Ejemplo:
Dim s As String
s = "Hola!"
'//Codifica
XORStringEncrypt s, "MiClave"
Show
Print "Codificado: "; s
'//Decodifica
XORStringEncrypt s, "MiClave"
Print "Decodificado: "; s
End Sub
Private Sub XORStringEncrypt(s As String, PassWord As String)
Dim n As Long
Dim i As Long
Dim Char As Long
n = Len(PassWord)
For i = 1 To Len(s)
Char = Asc(Mid$(PassWord, (i Mod n) - n * ((i Mod n) = 0), 1))
Mid$(s, i, 1) = Chr$(Asc(Mid$(s, i, 1)) Xor Char)
Next
End Sub
Leer una Cadena (string) dentro de otra...
En particular existen muchos comando tales conmo:
CommandString="Source=File.txt;Path=C:\CommonFiles;Title=;..."
Resulta que deseamos obtener lo que corresponde a Path= de la cadena
anterior. La siguiente funcin se usa de esta manera: s =
GetSubString(CommandString, "Path=", ";")
Public Function GetSubString( _
s As String, _
StartDelim As String, _
EndDelim As String _
) As String
Dim nStartDelim As Long
Dim nEndDelim As Long
nStartDelim = InStr(s, StartDelim)
If nStartDelim Then
nStartDelim = nStartDelim + Len(StartDelim)
nEndDelim = InStr(nStartDelim, s, EndDelim)
If nEndDelim Then
GetSubString = Mid$(s, nStartDelim, nEndDelim - nStartDelim)
End If
End If
End Function
En el siguiente ejemplo, obtengo el nombre de la base de datos de un
DataEnvirnment
Dim DE As New dePPDMMirror
gsDatabaseConnection = DE.cnnPPDMMirror.ConnectionString
gsDatabaseName = GetSubString(gsDatabaseConnection, "Source=", ";")
Set DE = Nothing
Fecha aleatoria
A veces es til, generalmente para pruebas, generar una fecha aleatoria
dentro de un rango, p.e deseo una fecha entre el 1/1/1960 y 1/1/2000,
llamariamos a esta funcin como MyDate=GetRandomDate("1/1/1960",
"1/1/2000")
Private Function GetRandomDate(ByVal StartDate As Date, ByVal EndDate As
Date) As Date
Static AnotherCall As Boolean
Dim nDays As Single
On Error GoTo ErrorHandler
If Not AnotherCall Then
Randomize Timer
AnotherCall = True
End If
nDays = DateValue(EndDate) - DateValue(StartDate)
GetRandomDate = CDate(DateValue(StartDate) + nDays * Rnd())
Exit Function
ErrorHandler:
GetRandomDate = Null
End Function
Trasnformar una Hora a Decimal (y viceversa...)
En algunos clculos es requerido transformar datos de hora a decimal y
viceversa (en Topografa es til). P.e. la hora 10:30 AM ser 10.5 en
decimal.
Public Function HourDec(h As Variant) As Variant
If Not IsNull(h) Then
HourDec = Hour(h) + Minute(h) / 60 + Second(h) / 3600
End If
End Function
Public Function DecHour(h As Variant) As Variant
Dim nHour As Integer
Dim nMinutes As Integer
Dim nSeconds As Integer

nHour = Int(h)
nMinutes = Int((h - nHour) * 60)
nSeconds = Int(((h - nHour) * 60 - nMinutes) * 60)
DecHour = nHour & ":" & nMinutes & ":" & nSeconds
End Function
Ejemplo:
Dim h As Single
Dim d As String
Cls
d = "10:37:58"
h = HourDec(d)
Print "Hora Decimal = "; d
Print "Hora Estndar = "; h
Print "Hora de Decimal a Estndar = "; DecHour(h)
End Sub
El parmetro de HourDec puede ser un dato Date, expresin que retorne
Date (por ejemplo la funcin Now), o una cadena, "hh:mm:ss" como en
ejemplo.
Incremento continuo
Desafortunadamente Visual Basic no tiene operador de incrementacin
continua, es decir el famoso i++ del lenguaje C. Podamos simular algo
parecido:
Public Static Function Plus(Optional Start As Variant) As Long
Dim i As Long
If Not IsMissing(Start) Then
i = Start-1
End If
i = i + 1
Plus = i
End Function
Esta pequea funcin puede ser extremadamente til en cdigo para obtener
recursos, digamos que es comn:
Dim I As Long
I=100
Caption = LoadResString(I)
lblPINCode = LoadResString(1 + I)
fraAccount = LoadResString(2 + I)
optChecking.Caption = LoadResString(3 + I)
optSavings.Caption = LoadResString(4 + I)
...
cmdOK.Caption = LoadResString(n + I)
Supongamos que hacemos un cambio en el archivo recursos : lblPINCode ya
no se usa en el formulario, y compilamos el recurso. Para actualizar el
cdigo tendremos que ir lnea por lnea para actualizar el I + x. - Nada
prctico. Mientras que si escribimos:
Caption = LoadResString(Plus(100))
lblPINCode = LoadResString(Plus)
fraAccount = LoadResString(Plus)
optChecking.Caption = LoadResString(Plus)
optSavings.Caption = LoadResString(Plus)
...
cmdOK.Caption = LoadResString(Plus)
La actualizacin mensionada consistir solo en eliminar la lnea:
lblPINCode = LoadResString(PlusI). Mejor imposible
Crear Cadenas Multineas de manera practica
Pienso que todos nos hemos hartado de escribir s = s + "algo"& vbCrLf & _
... etc. La siguiente funcin es una alternativa simple de crear cadenas
multiline:
Public Function StrChain(ParamArray v() As Variant) As String
Dim i As Integer
Dim n As Integer
Dim rtn As String
n = UBound(v)
For i = 0 To n
rtn = rtn & v(i)
If i < n Then
rtn = rtn & vbCrLf
End If
Next
StrChain = rtn
End Function
P.e:
Text1 = StrChain( _
"Hola", _
"cmo", _
"estas")
O simplemente Text1 = StrChain( "Hola", "cmo", "estas"), es ms cmodo
que:
Text1 = "Hola"& vbCrLf & "cmo" & VbCrLf
& "estas"
Claro, suponiendo que las cadenas concatenadas sean extensas, como un SQL
o un comando Script.
Saber si un archivo es binario o solo texto
Algunos archivos tienen extensiones personalizadas y algunas veces
debemos evaluar si son
o no binarios antes de procesarlos.
Public Function IsBinaryFile(File As String) As Boolean
Const aLf = 10, aCR = 13, aSP = 32
Const MaxRead = 2 ^ 15 - 1
Dim ff As Integer
Dim s As Integer
Dim i As Integer
Dim n As Integer
Dim Rtn As Boolean
On Error GoTo IsBinaryFile_Err
ff = FreeFile
Open File For Binary Access Read As #ff
n = IIf(LOF(ff) > MaxRead, MaxRead - 1, LOF(ff))
Do
i = i + 1
If i >= n Then
IsBinaryFile = False
Rtn = True
Else
s = Asc(Input$(1, #ff))
If s >= aSP Then
Else
If s = aCR Or s = aLf Then
Else
IsBinaryFile = True
Rtn = True
End If
End If
End If
Loop Until Rtn
Close ff
Exit Function
IsBinaryFile_Err:
If ff Then Close ff
MsgBox "Error verifying file " & File & vbCrLf & Err.Description
End Function
Simplemente pase el nombre del archivo al argumento y la funcin

retornata un valor bolean. Por ejemplo MsgBox " Es binario Command.Com ?
... " & IsBinaryFile("command.com").
Saber si un archivo es binario o solo texto
Algunos archivos tienen extensiones personalizadas y algunas veces
debemos evaluar si son
o no binarios antes de procesarlos.
Public Function IsBinaryFile(File As String) As Boolean
Const aLf = 10, aCR = 13, aSP = 32
Const MaxRead = 2 ^ 15 - 1
Dim ff As Integer
Dim s As Integer
Dim i As Integer
Dim n As Integer
Dim Rtn As Boolean
On Error GoTo IsBinaryFile_Err
ff = FreeFile
Open File For Binary Access Read As #ff
n = IIf(LOF(ff) > MaxRead, MaxRead - 1, LOF(ff))
Do
i = i + 1
If i >= n Then
IsBinaryFile = False
Rtn = True
Else
s = Asc(Input$(1, #ff))
If s >= aSP Then
Else
If s = aCR Or s = aLf Then
Else
IsBinaryFile = True
Rtn = True
End If
End If
End If
Loop Until Rtn
Close ff
Exit Function
IsBinaryFile_Err:
If ff Then Close ff
MsgBox "Error verifying file " & File & vbCrLf & Err.Description
End Function
Simplemente pase el nombre del archivo al argumento y la funcin
retornata un valor bolean. Por ejemplo MsgBox " Es binario Command.Com ?
... " & IsBinaryFile("command.com").
Como saber si mi form esta abierto...
El procedimiento IsLoadForm retorna un bolean que indica si el formulario
solicitado por su nombre se encuentra abierto. Opcionalmente se puede
hacer activo si se encuentra en memoria. La funcin es til en interfaces
MDI.
Public Function IsLoadForm(ByVal FormCaption As String, Optional Active
As Variant) As Boolean
Dim rtn As Integer, i As Integer
rtn = False
Name = LCase(FormCaption)
Do Until i > Forms.Count - 1 Or rtn
If LCase(Forms(i).Caption) = FormCaption Then rtn = True
i = i + 1
Loop
If rtn Then
If Not IsMissing(Active) Then
If Active Then
Forms(i - 1).WindowState = vbNormal

End If
End If
End If
IsLoadForm = rtn
End Function
Como contar los caracteres de una cadena...
Option Explicit
Function Cuantos(Inicio, Cadena As String, Caracter As String)
Dim Resultado, sCuantos
sCuantos = 0 'Inicializa la suma
'evita que entre si no hay nada que buscar
If IsNull(Cadena) Or IsNull(Caracter) Or Len(Cadena) = 0 Or
Len(Caracter)= 0 Then Exit Function
Resultado = InStr(Inicio, Cadena, Caracter) 'localiza la 1
coincidencia
Do While Resultado > 0 'y cuenta hasta que termina
sCuantos = sCuantos + 1
Inicio = Resultado + 1
Resultado = InStr(Inicio, Cadena, Caracter)
Loop
Cuantos = sCuantos
End Function
Obligar a introducir solamente nmeros (I)
Private Sub txtText1_KeyPress(KeyAscii As Integer)
'solo admitir dgitos, el punto y la coma
'si se pulsa alguna otra tecla, anular la pulsacin de teclado
If InStr("0123456789.,", Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub
Sub Text1_Keypress(KeyAscii As Integer)
If KeyAscii <> Asc("9") Then
'KeyAscii = 8 es el retroceso o BackSpace
If KeyAscii <> 8 Then
KeyAscii = 0
End If
End If
End Sub
Obligar a introducir solamente nmeros (II)
Private Sub txtText1_LostFocus()
If IsNumeric(txtText1) = False then
MsgBox "Lo siento. Debe Ingresar SOLAMENTE
Nmeros.",vbInformation,"Cuidado!"
txtText1.SetFocus
End If
Convertir nmeros en texto
Esta funcin, convierte un nmero en su correspondiente trascripcin a
letras. Funciona bien con
nmeros enteros y con hasta 2 decimales, pero ms de 2 decimales se
pierde y no "sabe" lo que dice.
Debes introducir este cdigo en un mdulo (por ejemplo) y realizar la
llamada con el nmero que
deseas convertir. Por Ejemplo: Label1 = Numlet(CCur(Text1))
Option Explicit
Dim Unidades$(9), Decenas$(9), Oncenas$(9)
Dim Veintes$(9), Centenas$(9)
Function Numlet$(NUM#)
Dim DEC$, MILM$, MILL$, MILE$, UNID$
ReDim SALI$(11)
Dim var$, I%, AUX$
'NUM# = Round(NUM#, 2)
var$ = Trim$(Str$(NUM#))
If InStr(var$, ".") = 0 Then
var$ = var$ + ".00"
End If
If InStr(var$, ".") = Len(var$) - 1 Then
var$ = var$ + "0"
End If
var$ = String$(15 - Len(LTrim$(var$)), "0") + LTrim$(var$)
DEC$ = Mid$(var$, 14, 2)
MILM$ = Mid$(var$, 1, 3)
MILL$ = Mid$(var$, 4, 3)
MILE$ = Mid$(var$, 7, 3)
UNID$ = Mid$(var$, 10, 3)
For I% = 1 To 11: SALI$(I%) = " ": Next I%
I% = 0
Unidades$(1) = "UNA "
Unidades$(2) = "DOS "
Unidades$(3) = "TRES "
Unidades$(4) = "CUATRO "
Unidades$(5) = "CINCO "
Unidades$(6) = "SEIS "
Unidades$(7) = "SIETE "
Unidades$(8) = "OCHO "
Unidades$(9) = "NUEVE "
Decenas$(1) = "DIEZ "
Decenas$(2) = "VEINTE "
Decenas$(3) = "TREINTA "
Decenas$(4) = "CUARENTA "
Decenas$(5) = "CINCUENTA "
Decenas$(6) = "SESENTA "
Decenas$(7) = "SETENTA "
Decenas$(8) = "OCHENTA "
Decenas$(9) = "NOVENTA "
Oncenas$(1) = "ONCE "
Oncenas$(2) = "DOCE "
Oncenas$(3) = "TRECE "
Oncenas$(4) = "CATORCE "
Oncenas$(5) = "QUINCE "
Oncenas$(6) = "DIECISEIS "
Oncenas$(7) = "DIECISIETE "
Oncenas$(8) = "DIECIOCHO "
Oncenas$(9) = "DIECINUEVE "
Veintes$(1) = "VEINTIUNA "
Veintes$(2) = "VEINTIDOS "
Veintes$(3) = "VEINTITRES "
Veintes$(4) = "VEINTICUATRO "
Veintes$(5) = "VEINTICINCO "
Veintes$(6) = "VEINTISEIS "
Veintes$(7) = "VEINTISIETE "
Veintes$(8) = "VEINTIOCHO "
Veintes$(9) = "VEINTINUEVE "
Centenas$(1) = " CIENTO "
Centenas$(2) = " DOSCIENTOS "
Centenas$(3) = " TRESCIENTOS "
Centenas$(4) = "CUATROCIENTOS "
Centenas$(5) = " QUINIENTOS "
Centenas$(6) = " SEISCIENTOS "
Centenas$(7) = " SETECIENTOS "
Centenas$(8) = " OCHOCIENTOS "
Centenas$(9) = " NOVECIENTOS "
If NUM# > 999999999999.99 Then Numlet$ = " ": Exit Function
If Val(MILM$) >= 1 Then

SALI$(2) = " MIL ": '** MILES DE MILLONES
SALI$(4) = " MILLONES "
If Val(MILM$) <> 1 Then
Unidades$(1) = "UN "
Veintes$(1) = "VEINTIUN "
SALI$(1) = Descifrar$(Val(MILM$))
End If
End If
If Val(MILL$) >= 1 Then
If Val(MILL$) < 2 Then
SALI$(3) = "UN ": '*** UN MILLON
If Trim$(SALI$(4)) <> "MILLONES" Then
SALI$(4) = " MILLON "
End If
Else
SALI$(4) = " MILLONES ": '*** VARIOS MILLONES
Unidades$(1) = "UN "
Veintes$(1) = "VEINTIUN "
SALI$(3) = Descifrar$(Val(MILL$))
End If
End If
For I% = 2 To 9
Centenas$(I%) = Mid$(Centenas(I%), 1, 11) + "AS"
Next I%
If Val(MILE$) > 0 Then
SALI$(6) = " MIL ": '*** MILES
If Val(MILE$) <> 1 Then
SALI$(5) = Descifrar$(Val(MILE$))
End If
End If
Unidades$(1) = "UNA "
Veintes$(1) = "VEINTIUNA"
If Val(UNID$) >= 1 Then
SALI$(7) = Descifrar$(Val(UNID$)): '*** CIENTOS
If Val(DEC$) >= 10 Then
SALI$(8) = " CON ": '*** DECIMALES
SALI$(10) = Descifrar$(Val(DEC$))
End If
End If
If Val(MILM$) = 0 And Val(MILL$) = 0 And Val(MILE$) = 0 And
Val(UNID$) = 0 Then SALI$(7) = " CERO "
AUX$ = ""
For I% = 1 To 11
AUX$ = AUX$ + SALI$(I%)
Next I%
Numlet$ = Trim$(AUX$)
End Function
Function Descifrar$(numero%)
Static SAL$(4)
Dim I%, CT As Double, DC As Double, DU As Double, UD As Double
Dim VARIABLE$
For I% = 1 To 4: SAL$(I%) = " ": Next I%
VARIABLE$ = String$(3 - Len(Trim$(Str$(numero%))), "0") +
Trim$(Str$(numero%))
CT = Val(Mid$(VARIABLE$, 1, 1)): '*** CENTENA
DC = Val(Mid$(VARIABLE$, 2, 1)): '*** DECENA
DU = Val(Mid$(VARIABLE$, 2, 2)): '*** DECENA + UNIDAD
UD = Val(Mid$(VARIABLE$, 3, 1)): '*** UNIDAD
If numero% = 100 Then
SAL$(1) = "CIEN "
Else
If CT <> 0 Then SAL$(1) = Centenas$(CT)

If DC <> 0 Then
If DU <> 10 And DU <> 20 Then
If DC = 1 Then SAL$(2) = Oncenas$(UD): Descifrar$
= Trim$(SAL$(1) + " " + SAL$(2)) then
Exit
Function
If DC = 2 Then SAL$(2) = Veintes$(UD):
Descifrar$ = Trim$(SAL$(1) + " " + SAL$(2)) then
Exit Function
End If
SAL$(2) = " " + Decenas$(DC)
If UD <> 0 Then SAL$(3) = "Y "
End If
If UD <> 0 Then SAL$(4) = Unidades$(UD)
End If
Descifrar = Trim$(SAL$(1) + SAL$(2) + SAL$(3) +
SAL$(4))
End Function
Seleccionar todo el Texto al recibir el Foco
Insertar el siguiente Codigo en el evento GotFocus de un TextBox:
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLenght = Len(Text1.Text)
End Sub
Convertir a Maysculas/Minsculas segun vamos escribiendo
Insertar el siguiente Codigo en el evento Change de un control TextBox
Private Sub Text1_Change()
Dim I as Integer
Text1.Text = UCase(Text1.Text)
I = Len(Text1.Text)
Text1.SelStart(I)
End Sub
Nota: Si queremos convertir a minusculas, solo hay que cambiar UCase por
LCase. Este codigo convierte a mayusculas/minusculas segun vamos
escribiendo.Pasar de Decimal a Binario
Function DecimalABinario(ByVal valor As Long) As String
' Declaracin de variables privadas a la funcin
Dim mayor As Integer
Dim retorno As String
Dim a As Integer
' Localizamos el mayor exponente
mayor = 0
Do While True
If 2 ^ mayor > valor Then
If mayor > 0 Then
mayor = mayor - 1
End If
Exit Do
End If
mayor = mayor + 1
Loop
' Calculamos el valor binario
retorno = ""
For a = mayor To 0 Step -1
If valor < (2 ^ a) Then
retorno = retorno & "0"
Else
retorno = retorno & "1"
valor = valor - (2 ^ a)
End If
Next a
DecimalABinario = retorno
End Function
Inhabilitar por un ratito los botones de la barra Inicio:
Los eventos Resize suelen tener ejecucin asncrona. Cuando un formulario
utiliza controles ActiveX complejos (lase acceso a datos) que toman
acciones de redimensionamiento, pueden fallar si el usuario, por ejemplo,
maximiza la ventana antes de que termine de cargarse el formulario, o
situaciones similares. La siguiente tcnica permite evitar este efecto.
'//Protect while loading
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 GetWindowLong Lib "user32" Alias
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Public Sub EnabledToolBoxMenu(frm As Form, Action As Boolean)
Static rtn, rtnI
If Action Then
If rtnI Then
rtn = SetWindowLong(frm.hwnd, GWL_STYLE, rtnI)
End If
Else
rtnI = GetWindowLong(frm.hwnd, GWL_STYLE)
rtn = rtnI And Not (WS_SYSMENU)
rtn = SetWindowLong(frm.hwnd, GWL_STYLE, rtn)
End If
End Sub
La forma correcta de usar el procedimiento es la siguiente:
Private Loading
Loading=True
'//Cdigo de carga...
Loading=False
EnabledToolBoxMenu Me, True
End Sub
Private Sub Form_Activate()
If Loading Then
EnabledToolBoxMenu Me, False
End If
End Sub
NOTA. Se pueden inhabilitar / habilitar separadamente los btones. API
suministra otras constantes similares a WS_SYSMENU. Ver documentacin de
SetWindowLong.
Ejecutar un programa DOS desde VB
Shell "C:\WINDOWS\COMMAND\EDIT.COM", vbNormalFocus
End Sub
Ejecutar Microsoft Word desde VB
Hay que hacer automatizacin, o sea, instanciar un objeto Word
Dim oWord as new Word.ApplicationoWord.Visible = True 'Si quieres abrir
un documento en blanco o uno concreto
oWord.Documents.Add
oWord.Documents.Open "<Path\Nombre del documento>"
Bloquear el Boton Inicio, Crtl + Tab y Ctrl + Alt + Supr
Declarar en un Mdulo lo siguiente:
Public Declare Function SystemParametersInfo Lib "user32" Alias
"SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any,
ByVal fuWinIni As Long) As Long
(Ojo, toda esta declaracion debe estar en una sola linea!!)
En el Evento Click del Form1 colocar lo siguiente:

Sub Form_Click()
Dim blnOld as Boolean
If MsgBox ("Desea Bloquear ahora?", vbInformation + vbYesNo,
"Bloqueo") = vbYes then
SystemParametersInfo 97&, True, blnOld, 0&
Else
SystemParametersInfo 97&, False, blnOld, 0&
End If
End Sub
Activar/Desactivar el Bloqueo de Mayusculas
Solamente necesitamos declarar en un Modulo lo siguiente:
Public Declare Function GetKeyboardState Lib "user32" Alias
"GetKeyboardState" (pbKeyState As Byte) As Long
Public Declare Function SetKeyboardState Lib "user32" Alias
"SetKeyboardState" (lppbKeyState As Byte) As Long
Public Type KeyboardBytes
kbByte(0 To 255) as Byte
End Type
En el Evento Click de la ventana (Form) colocaremos el siguiente codigo y
nos fijaremos en la actitud de
la lucecita del Bloqueo de Mayusculas...
Dim kbArray as KeyboardBytes
GetKeyboardState kbArray
kbArray.kbByte(&H14) = IIF(kbArray.kbByte(&H14) = 1, 0, 1)
SetKeyboardState kbArray
End Sub
Cmo Activar el Protector de Pantallas?
En un modulo, declarar lo siguiente:
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long,
lParam As Any) As Long
y en el evento click de un boton:
Call SendMessage(Me.hWnd, &H112, &HF140, 0&)
End Sub
Ocultar / Mostrar la Barra de Herramientas de WIn95/NT
Poner el siguiente Codigo en un Modulo:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal
hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As
Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Global Ventana as Long
Global Const Muestra = &H40
Global Const Oculta = &H80
(NOTA: Las dos declaraciones deben estar en una misma Linea)
Poner dos (2) botones en un Form y escribir:
Ventana = FindWindow("Shell_Traywnd", " ")
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta)
End Sub
Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra)
End Sub
Cambiar el Papel Tapiz de Win95
Insertar el siguiente Codigo en un Modulo:
Declare Function SystemParametersInfo Lib "user32" Alias

"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long,
ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Nota: Debe estar todo en una sola linea (Usar el Visor de Texto API, que
viene con Visual Basic)
Insertar el siguiente Codigo en el evento Click de un CommandButton
Dim Cambio as Integer
Cambio = SystemParametersInfo(20, 0, "C:\Windows\Nubes.bmp", 0)
End Sub
Mandar un E-Mail llamando a la aplicacion por Default
En un Modulo colocar:
Public Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal
lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_SHOW = 5
En el evento click de un boton...
Dim X as Long
X = ShellExecute hWnd, "open", "mailto:[email protected]",
vbNullString, vbNullString, SW_SHOW
End Sub
Como saber el Espacio libre del Disco
Crear un mdulo y escribir:
Declare Function GetDiskFreeSpace Lib "kernel32" Alias
"GetDiskFreeSpaceA"_
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long,
lpBytesPerSector_
As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long)
As Long
Dim I1 As Long
Dim I2 As Long
Dim I3 As Long
Dim I4 As Long
Dim Unidad As String
Unidad = "C:/"
GetDiskFreeSpace Unidad, I1, I2, I3, I4
Label1.Caption = Unidad
Label2.Caption = I1 & " Sectores por cluster"
Label3.Caption = I2 & " Bytes por sector"
Label4.Caption = I3 & " Nmero de clusters libres"
Label5.Caption = I4 & " Nmero total de clusters"
Label6.Caption = "Espacio total en disco: " & (I1 * I2 * I4)
Label7.Caption = "Espacio libre en disco: " & (I1 * I2 * I3)
End Sub
(Nota: Este cdigo vale igualmente para los CD-ROM y disquetes. La letra
de la unidad puede estar en letra minscula o mayscula).
Comprobar si el Protocolo TCP/IP est instalado
Si bien esta no es una solucin no muy buena, pero por lo menos sirve...
Mediante acceso a la API, puedes abrir el entorno de red para ver que es
lo que hay instalado, y si el TCP/IP
no lo est ,que lo haga el usuario...
El cdigo referente a esto es....
X = Shell("Rundll32.exe shell32.dll,Control_RunDLL NetCPL.cpl @0")
Mover un Archivo a la Papelera en lugar de usar KILL
Crear un formulario y escribir el siguiente cdigo (en las declaraciones
Generales):
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Sub PapeleraDeReciclaje(ByVal Fichero As String)
Dim SHFileOp As SHFILEOPSTRUCT
Dim RetVal As Long
With SHFileOp
.wFunc = FO_DELETE
.pFrom = Fichero
End With
RetVal = SHFileOperation(SHFileOp)
End Sub
Private Sub CommandButton1_Click()
PapeleraDeReciclaje "c:\a.txt"
End Sub
El programa preguntar si deseamos o no eliminar el archivo y enviarlo a
la papelera de reciclaje. El parmetro .fFlags nos permitir recuperar el
fichero de la papelera si lo deseamos. Si eliminamos esta lnea, el
fichero no podr ser recuperado.
Deshabilitar el ingreso de texto en ciertos TextBox...
Private Sub txtCampo_KeyPress(KeyAscii As Integer)
keyascii=0
End Sub
Insertar el siguiente Codigo en un Modulo:
Declare Function mciExecute Lib "winmm.dll" ( ByVal lpstrCommand As
String)
Insertar el siguiente codigo en el boton del formulario:
iResult = mciExecute(" Play C:\WINDOWS\RINGIN.WAV")
End Sub
Escuchar un Archivo MIDI / WAV (2)
Primero tienes que insertar un MMControl en el formulario.
Luego, en propiedades lo haces invisible.
Haz doble click en el formulario y activa la opcin LOAD, que se refiere
a cuando se carga el formulario.
Finalmente escribe lo siguiente:
MMCONTROL1.FILENAME=("ruta y nombre del archivo Mid")
MMCONTROL1.COMMAND=OPEN 'para abrir el control
MMCONTROL1.COMMAND=PLAY 'para iniciar la ejecucin
MMCONTROL1.COMMAND=STOP 'para parar la ejecucin
MMCONTROL1.COMMAND=CLOSE 'para cerrar el control
Abrir / Cerrar la Unidad de CD
El procedimiento para lograr esto es el siguiente:
En la seccin Declaraciones de un Form, colocar el siguiente cdigo:
(podes sacarlo de el API Viewer /Visor de Texto API): (Todo debe ir en
una sola linea...!)
Private Declare Function mciSendString Lib "winmm.dll" Alias
"mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString
As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As
Long
En el mismo form (ej.: form1) colocar dos botones: Abrir y Cerrar.
En el codigo del boton Abrir, colocamos el siguiente codigo:
ret = mciSendString("set CDAudio door open", returnstring, 127, 0)

Y en el codigo del boton Cerrar, colocamos el siguiente codigo:
ret = mciSendString("set CDAudio door closed", returstring, 127, 0)
Listo!!
Imprimir una imagen
Ejemplo.
El modo de escala en que se trabaja es Pixeles, el modo de impresin es
Centmetros, y se imprimir el contenido creado en un PictureBox usando
mtodos grficos (PSet, Line, Circle, ...). Si se desea imprimir el
Picture, simplemente en vez de Image, usamos Picture (esta resaltado con
cursiva). Se imprime en una rea de 4 por 4 cm, con margen 1 cm a la
izquierda, 1 cm arriba.
ptrX1 = 1 '//cm
ptrX2 = 5 '//cm
ptrY1 = 1 '//cm
ptrY2 = 5 '//cm
...
With pic_AnyName
Printer.ScaleMode = vbCentimeters
.Parent.ScaleMode = vbCentimeters
.ScaleMode = vbCentimeters
Printer.PaintPicture .Image, _
ptrX1, ptrY1, (ptrX2 - ptrX1), (ptrY2 - ptrY1), _
0, 0, .Width, .Height, vbSrcCopy
.Parent.ScaleMode = vbPixels
.ScaleMode = vbPixels
End With
Imprimir archivos "PRN"
Los archivos PRN son trabajos de impresora generados por Windows en
conjunto con el Driver de alguna Impresora. Para generarlos, creamos una
Impresora con salida a archivo. As, podemos generar un archivo de
impresora en vez de enviar directamente la salida a Printer. El siguiente
procedimiento ejecuta la tarea de Impresin:
Private CancelPrinting As Boolean
Private Sub PrintPRNFile(PRNFile As String)
Const Buffer As Long = 8192
Dim Chunk As String
Dim numLoops As Long
Dim LeftOver As Long
Dim i As Long
Dim FCnl As Long
Dim PCnl As Long
On Error GoTo SubErr
'//Abre el archivo y el port de impresora
Screen.MousePointer = vbHourglass
CancelPrinting = False
FCnl = FreeFile
Open PRNFile For Binary Access Read As #FCnl
PCnl = FreeFile
Open CStr(Printer.Port) For Binary Access Write As #PCnl
'//Calcula el tamao del archivo
numLoops = LOF(1) \ Buffer
LeftOver = LOF(1) Mod Buffer
'//lo imprime
Chunk = Space$(Buffer)
For i = 1 To numLoops
Get #FCnl, , Chunk
Put #PCnl, , Chunk
DoEvents
If CancelPrinting Then Exit For
Next
If Not CancelPrinting Then
Chunk = Space$(LeftOver)
Get #FCnl, , Chunk
Put #PCnl, , Chunk
End If
EndSub:
Close #FCnl, #PCnl
Screen.MousePointer = vbDefault
Exit Sub
SubErr:
MsgBox Err.Description, vbInformation, "Impresion del archivo..."
Resume EndSub
End Sub
RECOMENDACIONES.
Es conveniente colocar un Botn para configurar la Impresora antes de
enviar el trabajo (un archivo de impresora debe ejecutarse con el mismo
controlador de la impresora que lo creo). Adicionamos un control
CommonDialog, y:
Private Sub cmdConfig_Click()
cdlPrinterSetup.Flags = cdlPDPrintSetup
cdlPrinterSetup.ShowPrinter
DoEvents
End Sub
Tambin es conveniente crear la opcin de cancelar:
Private Sub cmdCancel_Click()
CancelPrinting = True
End Sub
Impresion Directa con VB?
Open "LPT1" For Output As #1
Print #1, Chr(27) & "W" & Chr(1); "Hola, mundo" & Chr(27) & "W" &
Chr(0) 'Imprime en ancho doble
Print #1, Chr(15) & "Nro. de boleta" & Chr(17) 'Imprime condensado
Close #1
End Sub
Imprimir un TextBox en lineas de X caracteres...
Aade un TextBox con las propiedades "Multiline=True" y
"ScrollBars=Vertical", y
un CommandButton. Haz doble click sobre l y escribe este cdigo:
'X es 60 en este ejmplo
ImprimeLineas Text1, 60
End Sub
Public Sub ImprimeLineas(Texto As Object, Linea As Integer)
Dim Bloque As String
'Numero de caracteres = NumC
'Numero de Bloques = NumB
Dim NumC, NumB As Integer
NumC = Len(Texto.Text)
If NumC > Linea Then
NumB = NumC \ Linea
For I = 0 To NumB
Texto.SelStart = (Linea * I)
Texto.SelLength = Linea
Bloque = Texto.SelText
Printer.Print Bloque
Next I
Else
Printer.Print Texto.Text
End If
Printer.EndDoc
End Sub
Imprimir en modo apaisado/vertical:
printer.Orientation=vbPRPRPPortrait 'horizontal
printer.Orientation=bPRPLandScape 'vertical
Lanzar (o imprimir) un documento de Word cualquiera
Con este cdigo, Word no se abre, imprime el doc, se cierra y libera
memoria
Dim AppWord As Word.Application
Dim DocWord As Word.Document
'Asignamos el documento
Set AppWord = CreateObject("word.application")
Set DocWord = AppWord.Documents.Open("C:\hola.doc")
'Colocamos el texto en el marcador
DocWord.Bookmarks("NombreCreador").Select
AppWord.Selection.TypeText Text:=Text1.Text
'Imprimimos en segundo plano
AppWord.Documents(1).PrintOut Background
'Comprobamos que Word no sigue imprimiendo
Do While AppWord.BackgroundPrintingStatus = 1
Loop
'Cerramos el documento sin guardar cambios
AppWord.Documents.Close (wdDotNotSaveChanges)
'Liberamos
Set DocWord = Nothing
'Nos cargamos el objeto creado
AppWord.Quit
Set AppWord = Nothing
End Sub
Imprimir el contenido de un RichTextBox tal como se ve:
Insertar el siguiente Codigo en el evento Click de un CommandButton
On Error GoTo ElError
Printer.Print " "
RichTextBox1.SelPrint Printer.hDC
Printer.EndDoc
ElError:
End Sub
Usa esa cadena asi:

Var = Microsoft.VisualBasic.Format(Datatimepic... "DD/MM/YYYY HH:MM:SS")
Si estas manejando una fecha actual, entonces escribe:
Var = Microsoft.VisualBasic.Format(Now, "DD/MM/YYYY HH:MM:SS")
Se nota con el viejo estilo del VB60, pero es valido tambien en Visual Basic .NET (2003) y
2005.
Suponiendo que Var es del tipo String, debes de tener cuidado que cuando metas una
consulta SQL a una BD de SQL Server. Acuerdate que el tipo de dato DateTime o
SmallDatetime debe de meterse del siguiente modo:
SELECT ("2007-10-05 12:00:00) AS FECHA;
Si estas manejando una BD de Orale, el formato de insercion seria asi:
SELECT TOCHAR(FECHA1, "DD/MM/YYYY HH:MM:SS") AS FECHA

suponiendo que FECHA1 es del tipo DATE en Oracle.
Dudas o comentarios a [email protected]
All the patterns:

0 MM/dd/yyyy
08/22/2006
1 dddd, dd MMMM yyyy
Tuesday, 22 August 2006
HH:mm Tuesday, 22 August 2006 06:30
hh:mm tt Tuesday, 22 August 2006 06:30 AM
H:mm Tuesday, 22 August 2006 6:30
h:mm tt Tuesday, 22 August 2006 6:30 AM
6 dddd, dd MMMM yyyy HH:mm:ss
Tuesday, 22 August 2006 06:30:07
7 MM/dd/yyyy HH:mm
08/22/2006 06:30
8 MM/dd/yyyy hh:mm tt
08/22/2006 06:30 AM
9 MM/dd/yyyy H:mm
08/22/2006 6:30
10 MM/dd/yyyy h:mm tt
08/22/2006 6:30 AM
08/22/2006 6:30 AM
08/22/2006 6:30 AM
11 MM/dd/yyyy HH:mm:ss
08/22/2006 06:30:07
12 MMMM dd
August 22
13 MMMM dd
August 22
14 yyyy'-'MM'-'dd'T'HH':'mm':'ss.fffffffK
2006-08-22T06:30:07.7199222-04:00
15 yyyy'-'MM'-'dd'T'HH':'mm':'ss.fffffffK
2006-08-22T06:30:07.7199222-04:00
16 ddd, dd MMM yyyy HH':'mm':'ss 'GMT' Tue, 22 Aug 2006 06:30:07 GMT
18 yyyy'-'MM'-'dd'T'HH':'mm':'ss
2006-08-22T06:30:07
19 HH:mm
06:30
20 hh:mm tt
06:30 AM
21 H:mm
6:30
22 h:mm tt
6:30 AM
23 HH:mm:ss
06:30:07
24 yyyy'-'MM'-'dd HH':'mm':'ss'Z'
2006-08-22 06:30:07Z
25 dddd, dd MMMM yyyy HH:mm:ss
Tuesday, 22 August 2006 06:30:07
26 yyyy MMMM
2006 August
27 yyyy MMMM
2006 August
The patterns for DateTime.ToString ( 'd' ) :

0 MM/dd/yyyy 08/22/2006
The patterns for DateTime.ToString ( 'D' ) :

0 dddd, dd MMMM yyyy Tuesday, 22 August 2006
The patterns for DateTime.ToString ( 'f' ) :

0 dddd, dd MMMM yyyy HH:mm Tuesday, 22 August 2006 06:30
1 dddd, dd MMMM yyyy hh:mm tt Tuesday, 22 August 2006 06:30 AM
2 dddd, dd MMMM yyyy H:mm
Tuesday, 22 August 2006 6:30
3 dddd, dd MMMM yyyy h:mm
tt Tuesday, 22 August 2006 6:30 AM
The patterns for DateTime.ToString ( 'F' ) :

0 dddd, dd MMMM yyyy HH:mm:ss Tuesday, 22 August 2006 06:30:07
The patterns for DateTime.ToString ( 'g' ) :

0 MM/dd/yyyy HH:mm 08/22/2006 06:30
1 MM/dd/yyyy hh:mm tt 08/22/2006 06:30 AM
2 MM/dd/yyyy H:mm
08/22/2006 6:30
3 MM/dd/yyyy h:mm tt 08/22/2006 6:30 AM
The patterns for DateTime.ToString ( 'G' ) :

0 MM/dd/yyyy HH:mm:ss 08/22/2006 06:30:07
The patterns for DateTime.ToString ( 'm' ) :

0 MMMM dd August 22
The patterns for DateTime.ToString ( 'r' ) :

The patterns for DateTime.ToString ( 's' ) :
0 yyyy'-'MM'-'dd'T'HH':'mm':'ss 2006-08-22T06:30:07
The patterns for DateTime.ToString ( 'u' ) :

0 yyyy'-'MM'-'dd HH':'mm':'ss'Z' 2006-08-22 06:30:07Z
The patterns for DateTime.ToString ( 'U' ) :

0 dddd, dd MMMM yyyy HH:mm:ss Tuesday, 22 August 2006 06:30:07
The patterns for DateTime.ToString ( 'y' ) :

ToString("yyyy-MM-dd HH:mm:ss:fff")
El formato DateTime no es si o si "dd/MM/yyyy HH:mm:ss", no pienses en el tipo de dato como si

tuviera un formato. El DateTime es un objeto, y tiene las propiedades Day, Month, Year, ......
Cuando vos lo mostras podes hacerlo con el formato que quieras. Asumo que para mostrarlo
estaras usando el metodo .ToString(), que te convierte todos esos valores a un texto con el formato
predeterminado que tiene tu maquina (lo toma de la configuracion regional), en este caso
dd/MM/yyyy HH:mm:ss. En vez de eso podrias hacer asi:
.ToString("dd/MM/yyyy HH:mm")
y eso te devolveria un texto con la fecha en ese formato (podes poner vos el formato que quieras).
Cuidado!. El metodo Parse, que usas para obtener la fecha a partir del texto, tambien varia segun
la configuracion de la maquina. Por ejemplo, en tu maquina te devuelve 09 de enero, pero en otra
maquina podria devolver 01 de septiembre.
Para hacerlo bien, deberias especificar ademas en que formato viene la fecha que contiene el
string. Eso lo harias asi:
System.IFormatProvider MiFp = new System.Globalization.CultureInfo("es-ES",false);
System.DateTime fechaR = new System.DateTime();
fechaR= System.DateTime.ParseExact(fechaReco, "dd/MM/yyyy HH:mm", MiFp);
despues, cuando necesites mostrar la fecha en algun lugar, usarias:
fechaR.ToString("dd/MM/yyyy HH:mm")
Bueno, espero haber ayudado.
Chau, suerte!
This C# code snippet displays the date and time in various formats.
using C = System.Console;
...
static void Main() {
DateTime dateTime = DateTime.Now;
C.WriteLine ("d = {0:d}", dateTime );
C.WriteLine ("D = {0:D}", dateTime );
C.WriteLine ("f = {0:f}", dateTime );
// mm/dd/yyyy
// month dd, yyyy
// day, month dd, yyyy hh:mm
C.WriteLine
AM/PM
C.WriteLine
C.WriteLine
C.WriteLine
C.WriteLine
C.WriteLine
(Sortable)
C.WriteLine
C.WriteLine
("F = {0:F}", dateTime );
// day, month dd, yyyy HH:mm:ss
("g
("G
("M
("R
("s
//
//
//
//
//
=
=
=
=
=
{0:g}",
{0:G}",
{0:M}",
{0:R}",
{0:s}",
dateTime
dateTime
dateTime
dateTime
dateTime
);
);
);
);
);
("t = {0:t}", dateTime );

("T = {0:T}", dateTime );
mm/dd/yyyy HH:mm
mm/dd/yyyy hh:mm:ss
month dd
ddd Month yyyy hh:mm:ss GMT
yyyy-mm-dd hh:mm:ss
// hh:mm AM/PM
// hh:mm:ss AM/PM
// yyyy-mm-dd hh:mm:ss (Sortable)

C.WriteLine ("u = {0:u}", dateTime );
// day, month dd, yyyy hh:mm:ss AM/PM
C.WriteLine ("U = {0:U}", dateTime );
// month, yyyy (March, 2006)
C.WriteLine ("Y = {0:Y}", dateTime );
C.WriteLine ("Month = " + dateTime.Month); // month number (3)
// day of week name (Friday)
C.WriteLine ("Day Of Week = " + dateTime.DayOfWeek);
// 24 hour time (16:12:11)
C.WriteLine ("Time Of Day = " + dateTime.TimeOfDay);
// (632769991310000000)
C.WriteLine("DateTime.Ticks = " + dateTime.Ticks);
// Ticks are the number of 100 nanosecond intervals since 01/01/0001
12:00am
// Ticks are useful in elapsed time measurement.
}
Date and time formatting example (program output)

d = 3/3/2006
D = Friday, March 03, 2006
f = Friday, March 03, 2006 4:20 PM
F = Friday, March 03, 2006 4:20:26 PM
g = 3/3/2006 4:20 PM
G = 3/3/2006 4:20:26 PM
M = March 03
R = Fri, 03 Mar 2006 16:20:26 GMT
s = 2006-03-03T16:20:26
t = 4:20 PM
T = 4:20:26 PM
u = 2006-03-03 16:20:26Z
U = Friday, March 03, 2006 10:20:26 PM
Y = March, 2006
Month = 3
Day Of Week = Friday
Time Of Day = 16:20:26.1406250
DateTime.Ticks = 632769996261406250

Trucos en Visual Basic

Cargado por

Copyright:

Formatos disponibles

Trucos en Visual Basic

Cargado por

Información del documento

Descripción original:

Derechos de autor

Formatos disponibles

Compartir este documento

Compartir o incrustar documentos

Opciones para compartir

¿Le pareció útil este documento?

¿Este contenido es inapropiado?

Copyright:

Formatos disponibles

Trucos en Visual Basic

Cargado por

Copyright:

Formatos disponibles

Trucos en Visual Basic

Cmo redondear un nmero

Funcin creada por Eduardo Frneas. Originalmente publicada en

Incluir en el formulario una etiqueta con un texto descriptivo. Incluir a

sNuevaTarjeta = sNuevaTarjeta & cCaracter

Public Const OPEN_ALWAYS = 4

Ejecute la aplicacin y pulse el botn para comprobar el estado de la

MsgBox CallByName(Me, Text1.Text, VbMethod, Text2.Text, Text3.Text)

Set Form2 = Nothing

Para registrar un fichero utilice Regsvr32.exe.

Para desregistrar un fichero utilice Regsvr32.exe /u.

Aplicable a partir de Microsoft Visual Basic 4.0 32 bits A continuacin,

producido en caso de fallo. Para obtener esta informacin en un formato

Cree un nuevo proyecto en Visual Basic. Form1 es creado por

Aada el siguiente cdigo a la seccin "Declaraciones" de Form1:

Aada una caja de texto a Form1. Text1 es creado por defecto.

Aada un botn a Form1. Command1 es creado por defecto. Establezca

Aada el siguiente cdigo al evento Click de Command1:

Aada un segundo botn a Form1. Command2 es creado por defecto.

Aada el siguiente cdigo al evento Click de Command2:

Cree un nuevo proyecto en Visual Basic. Por defecto, se crea el

Aada un control Listbox al Form1. Por defecto, la lista tiene el

Aada un botn tipo Command al Form1. Por defecto, el botn tiene

Aada un segundo botn tipo Command al Form1. Por defecto, el

Aada el siguiente cdigo al evento Click de Command1.

Aada el siguiente cdigo al evento Click de Command2.

Cree un nuevo proyecto en Visual Basic. Por defecto, se crea el

Aada un botn tipo Command al Form1. Por defecto, el botn tiene

Aada el siguiente cdigo al evento Click del Command1:

Aada el siguiente cdigo en la seccin Declaraciones del Form1:

"MMSYSTEM" (ByVal lpstrCommand$, _

Las aplicaciones de 32-bit pueden llamar a la funcin SHFileOperation de

(ByVal lpstrFolderName As String, _

Escribir el siguiente cdigo:

'Obtenemos un canal libre que nos dar

Escribir el siguiente cdigo:

Insertar un CommandButton y un TextBox y escribir el siguiente cdigo:

startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$))

msg = msg + Format$(memory& \ 1024, "###,###,###")

ByVal lpstrReturnString As Any,

Muchas veces, cuando se ingresa informacin en una caja de texto y se

Dim nSeconds As Integer

Simplemente pase el nombre del archivo al argumento y la funcin

Forms(i - 1).WindowState = vbNormal

If Val(MILM$) >= 1 Then

If CT <> 0 Then SAL$(1) = Centenas$(CT)

En el Evento Click del Form1 colocar lo siguiente:

Declare Function SystemParametersInfo Lib "user32" Alias

ret = mciSendString("set CDAudio door open", returnstring, 127, 0)

Usa esa cadena asi:

SELECT TOCHAR(FECHA1, "DD/MM/YYYY HH:MM:SS") AS FECHA

All the patterns:

1 dddd, dd MMMM yyyy

Tuesday, 22 August 2006

2 dddd, dd MMMM yyyy

HH:mm Tuesday, 22 August 2006 06:30

3 dddd, dd MMMM yyyy

hh:mm tt Tuesday, 22 August 2006 06:30 AM

4 dddd, dd MMMM yyyy