Como saber cuantos registros tiene el Recordset
Ustedes diran "¡Qué fácil! Usamos la propiedad RecordCount del Recordset" ..... Si y no. La propiedad RecordCount funciona bien si antes nos movemos hasta el último registro, sino, en algunos casos funciona y en otros no. Pero si nuestro recordset no tiene registros, no puede ejecutar el RS.MoveLast, ya que no tiene registros, y el programa da un error. Entonces podemos hacer lo siguiente:

Código:
If RS.EOF = True And RS.BOF = True Then
MsgBox "Nuestro Recordset no tiene registros"
else
RS.MoveLast
MsgBox "Nuestro Recordset tiene " & CStr(RS.RecordCount) & " registros
End If


Si el Recordset no tiene registros, tanto la propiedad EOF como la BOF tiene valor verdadero.

Otra Forma Para Ingresar Solo Numeros
Código:
Private Sub Text1_LostFocus()
If Not IsNumeric(Me.Text1.Text) Then
MsgBox ("Ingrese solo numeros")
End If
End Sub

Solo numeros en un Texbox
Código:
Function SoloNumeros(ByVal KeyAscii As Integer) As Integer
      ' Intercepta un codigo ASCII recibido admitiendo solamente
      ' caracteres numéricos, además:
      ' cambia el punto por una coma
      ' acepta el signo -
     
      ' deja pasar sin afectar si recibe tecla de borrado o return
       If KeyAscii = Asc(".") Then KeyAscii = Asc(",")
       If InStr("0123456789.,-", Chr(KeyAscii)) = 0 Then
          SoloNumeros = 0
         Else
          SoloNumeros = KeyAscii
        End If
        ' teclas especiales permitidas
        If KeyAscii = 8 Then SoloNumeros = KeyAscii  borrado atras
       
    End Function


Private Sub txtvalor_KeyPress(KeyAscii As Integer)
KeyAscii = SoloNumeros(KeyAscii)
End Sub

como Imprimir en tamaño especial en Impresoras Matriciales e
bueno yo tope con lo mismo y pedi soporte a You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login y me respondieron esto para las impresoras matriciales en windows XP con tamaño de papel "No", standar.

Para XP.

1. Acceda desde el botón INICIO (CONFIGURACIÓN) carpeta IMPRESORAS (Y
FAXES).

2. Seleccione el icono del driver haciendo un clic con el botón izquierdo
marcando el icono de la impresora EPSON.

3. Busque en el menú ARCHIVO la opción PROPIEDADES DEL SERVIDOR.

4. En la pestaña FORMULARIOS, active la casilla de verificación CREAR UN
NUEVO FORMULARIO.

5. Encontrará un cuadro de texto que dice DESCRIPCIÓN DEL FORMULARIO
(Medidas)

6. En este campo escriba un nombre que identifique su papel por ejemplo
NUEVO_FORMULARIO:

7. En el área MEDIDAS encontrará dos cuadros de valores que corresponderán a
la ANCHURA y ALTURA del formulario
que vaya a utilizar, si tiene seleccionado el botón MÉTRICO introduzca los
valores en centímetros.

8. Una vez introduzca las medidas tanto de altura como de anchura, pulse
sobre el botón GUARDAR FORMULARIO para
grabarlo y a partir de ese momento le aparecerá en la lista de la ventana
superior donde se puede escoger el papel
por defecto para esa impresora.

9. A continuación pulse sobre el botón ACEPTAR y le aparecerá para escoger
el nuevo papel NUEVO_FORMULARIO. En la
carpeta de impresoras, pulse el botón derecho del ratón sobre el icono de su
impresora, entre en 'Configuración predeterminada para este documento' y en
la pestaña de avanzadas, seleccione el tamaño de papel personalizado que
hemos creado.

Recuerde que es muy importante además de crear el formulario, definir en
la propia aplicación desde donde se
desea imprimir, el tamaño físico del formulario que deberá coincidir con las
medidas de NUEVO_FORMULARIO.

Tipos de Conexiones a Bases de Datos en Visual Basic
Bueno por alli yo investigando he econtrado estos tipos de conexiones

SQL Server

ODBC


Standard Security:

"Driver={SQL Server};Server=Aron1;Database=pubs;Uid=sa;Pwd=asda sd;"


Trusted connection:

"Driver={SQL Server};Server=Aron1;Database=pubs;Trusted_Connect ion=yes;"


Prompt for username and password:

oConn.Properties("Prompt") = adPromptAlways
oConn.Open "Driver={SQL Server};Server=Aron1;DataBase=pubs;"

Access

ODBC


Standard Security:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;Uid=Admin;Pwd=;"


Workgroup:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;SystemDB=C:\mydatab ase.mdw;"


Exclusive:

"Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\mydatabase.mdb;Exclusive=1;Uid=adm in;Pwd="

Oracle

ODBC


New version:

"Driver={Microsoft ODBC for Oracle};Server=OracleServer.world;Uid=Username;Pwd =asdasd;"


Old version:

"Driver={Microsoft ODBC Driver for Oracle};ConnectString=OracleServer.world;Uid=myUse rname;Pwd=myPassword;"

MySQL

ODBC


Local database:

"Driver={mySQL};Server=mySrvName;Option=16834;Data base=mydatabase;"


Remote database:

"Driver={mySQL};Server=data.domain.com;Port=3306;O ption=131072;Stmt=;Database=my-database;Uid=username;Pwd=password;"

Interbase

ODBC, Easysoft


Local computer:

"Driver={Easysoft IB6 ODBC};Server=localhost;Database=localhost:C:\mydat abase.gdb;Uid=username;Pwd=password"


Remote Computer:

"Driver={Easysoft IB6 ODBC};Server=ComputerName;Database=ComputerName:C: \mydatabase.gdb;Uid=username;Pwd=password"



ODBC, Intersolv


Local computer:

"Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};Server=localhost;Database=localhost:C:\my database.gdb;Uid=username;Pwd=password"


Remote Computer:

"Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};Server=ComputerName;Database=ComputerName :C:\mydatabase.gdb;Uid=username;Pwd=password"

Sybase

ODBC


Standard Sybase System 12 (or 12.5) Enterprise Open Client:

"Driver={SYBASE ASE ODBC Driver};Srvr=Aron1;Uid=username;Pwd=password"


Standard Sybase System 11:

"Driver={SYBASE SYSTEM 11};Srvr=Aron1;Uid=username;Pwd=password;"

Intersolv 3.10:

"Driver={INTERSOLV 3.10 32-BIT Sybase};Srvr=Aron1;Uid=username;Pwd=password;"


Sybase SQL Anywhere (former Watcom SQL ODBC driver):

"ODBC; Driver=Sybase SQL Anywhere 5.0; DefaultDir=c:\dbfolder\;Dbf=c:\mydatabase.db;Uid=u sername;Pwd=password;Dsn="""""



Informix

ODBC


Informix 3.30:

"Dsn='';Driver={INFORMIX 3.30 32 BIT};Host=hostname;Server=myserver;Service=service-name;Protocol=olsoctcp;Database=mydb;UID=username; PWD=myPwd


Informix-CLI 2.5:

"Driver={Informix-CLI 2.5 (32 Bit)};Server=myserver;Database=mydb;Uid=username;P wd=myPwd"

Mimer SQL

ODBC


Standard Security:

"Driver={MIMER};Database=mydb;Uid=myuser;Pwd=mypw; "


Prompt for username and password:

"Driver={MIMER};Database=mydb;"

DSN

ODBC


DSN:

"DSN=myDsn;Uid=username;Pwd=;"


File DSN:

"FILEDSN=c:\myData.dsn;Uid=username;Pwd=;"

Excel

ODBC


Standard:

"Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=C:\MyExcel.xls;DefaultDi r=c:\mypath;"

Text

ODBC


Standard:

"Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=c:\txtFilesFolder\;Extensions=asc,csv, tab,txt;"

DBF / FoxPro

ODBC


standard:

"Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=c:\mydbpath;"

Visual FoxPro

ODBC


Database container (.DBC):

"Driver={Microsoft Visual FoxPro Driver};SourceType=DBC;SourceDB=c:\myvfpdb.dbc;Exc lusive=No;Collate=Machine;"


Free Table directory:

"Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=c:\myvfpdbfolder;E xclusive=No;Collate=Machine;"

Pervasive

ODBC


Standard:

"Driver={Pervasive ODBC Client Interface};ServerName=srvname;dbq=@dbname"

OLE DB


Standard:

"Provider=PervasiveOLEDB;Data Source=C:\path"

UDL

UDL


UDL:

"File Name=c:\myDataLink.udl;"

Manual de como bloquear CTRL+ALT+SUP, ALT+TAB, Y OTROS WinXP
CTRL+ALT+SUP (TaskManager)

Se debe ingresar la instrucción "DisableTaskMgr" directamente en el regedit con el valor "1" en la carpeta abajo indicada, esto es fácil hacerlo desde VB.

[HKEY_CURRENT_USER\Software\Microsoft\Windows\Curre ntVersion\Policies\System]

Value Name: DisableTaskMgr

Data Type: REG_DWORD (DWORD Value)

Value Data: (0 = default, 1 = bloquea Task Manager)

------------------------------------------------------------------

ALT+TAB, CTRL+ESC (Tecla Windows), ALT+F4

Crear el siguiente Módulo (.BAS), no importa como le llamen

Código:
Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const WH_KEYBOARD_LL = 13

Public Type KBDLLHOOKSTRUCT
     vkCode As Long
     scanCode As Long
     flags As Long
     time As Long
     dwExtraInfo As Long
End Type

Public Enum VirtualKey
   VK_LBUTTON = &H1
   VK_RBUTTON = &H2
   VK_CTRLBREAK = &H3
   VK_MBUTTON = &H4
   VK_BACKSPACE = &H8
   VK_TAB = &H9
   VK_ENTER = &HD
   VK_SHIFT = &H10
   VK_CONTROL = &H11
   VK_ALT = &H12
   VK_PAUSE = &H13
   VK_CAPSLOCK = &H14
   VK_ESCAPE = &H1B
   VK_SPACE = &H20
   VK_PAGEUP = &H21
   VK_PAGEDOWN = &H22
   VK_END = &H23
   VK_HOME = &H24
   VK_LEFT = &H25
   VK_UP = &H26
   VK_RIGHT = &H27
   VK_DOWN = &H28
   VK_PRINTSCREEN = &H2C
   VK_INSERT = &H2D
   VK_DELETE = &H2E
   VK_0 = &H30
   VK_1 = &H31
   VK_2 = &H32
   VK_3 = &H33
   VK_4 = &H34
   VK_5 = &H35
   VK_6 = &H36
   VK_7 = &H37
   VK_8 = &H38
   VK_9 = &H39
   VK_A = &H41
   VK_B = &H42
   VK_C = &H43
   VK_D = &H44
   VK_E = &H45
   VK_F = &H46
   VK_G = &H47
   VK_H = &H48
   VK_I = &H49
   VK_J = &H4A
   VK_K = &H4B
   VK_L = &H4C
   VK_M = &H4D
   vk_n = &H4E
   VK_O = &H4F
   VK_P = &H50
   VK_Q = &H51
   VK_R = &H52
   VK_S = &H53
   VK_T = &H54
   VK_U = &H55
   VK_V = &H56
   VK_W = &H57
   VK_X = &H58
   VK_Y = &H59
   VK_Z = &H5A
   VK_LWINDOWS = &H5B
   VK_RWINDOWS = &H5C
   VK_APPSPOPUP = &H5D
   VK_NUMPAD_0 = &H60
   VK_NUMPAD_1 = &H61
   VK_NUMPAD_2 = &H62
   VK_NUMPAD_3 = &H63
   VK_NUMPAD_4 = &H64
   VK_NUMPAD_5 = &H65
   VK_NUMPAD_6 = &H66
   VK_NUMPAD_7 = &H67
   VK_NUMPAD_8 = &H68
   VK_NUMPAD_9 = &H69
   VK_NUMPAD_MULTIPLY = &H6A
   VK_NUMPAD_ADD = &H6B
   VK_NUMPAD_PLUS = &H6B
   VK_NUMPAD_SUBTRACT = &H6D
   VK_NUMPAD_MINUS = &H6D
   VK_NUMPAD_MOINS = &H6D
   VK_NUMPAD_DECIMAL = &H6E
   VK_NUMPAD_POINT = &H6E
   VK_NUMPAD_DIVIDE = &H6F
   VK_F1 = &H70
   VK_F2 = &H71
   VK_F3 = &H72
   VK_F4 = &H73
   VK_F5 = &H74
   VK_F6 = &H75
   VK_F7 = &H76
   VK_F8 = &H77
   VK_F9 = &H78
   VK_F10 = &H79
   VK_F11 = &H7A
   VK_F12 = &H7B
   VK_NUMLOCK = &H90
   VK_SCROLL = &H91
   VK_LSHIFT = &HA0
   VK_RSHIFT = &HA1
   VK_LCONTROL = &HA2
   VK_RCONTROL = &HA3
   VK_LALT = &HA4
   VK_RALT = &HA5
   VK_POINTVIRGULE = &HBA
   VK_ADD = &HBB
   VK_PLUS = &HBB
   VK_EQUAL = &HBB
   VK_VIRGULE = &HBC
   VK_SUBTRACT = &HBD
   VK_MINUS = &HBD
   VK_MOINS = &HBD
   VK_UNDERLINE = &HBD
   VK_POINT = &HBE
   VK_SLASH = &HBF
   VK_TILDE = &HC0
   VK_LEFTBRACKET = &HDB
   VK_BACKSLASH = &HDC
   VK_RIGHTBRACKET = &HDD
   VK_QUOTE = &HDE
   VK_APOSTROPHE = &HDE
End Enum

Dim p As KBDLLHOOKSTRUCT

Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim fEatKeystroke As Boolean
   If (nCode = HC_ACTION) Then
     If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
       CopyMemory p, ByVal lParam, Len(p)
       fEatKeystroke = _
         (p.vkCode = VK_CAPSLOCK) Or _
         (p.vkCode = VK_LWINDOWS) Or _
         (p.vkCode = VK_RWINDOWS) Or _
         (p.vkCode = VK_APPSPOPUP) Or _
         ((p.vkCode = VK_SPACE) And ((GetKeyState(VK_ALT) And &H8000) <> 0)) Or _
         ((p.vkCode = VK_TAB) And ((GetKeyState(VK_ALT) And &H8000) <> 0)) Or _
         ((p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0))
     End If
   End If
   If fEatKeystroke Then
     LowLevelKeyboardProc = -1
   Else
     LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
   End If
End Function


Es mucho texto, sugiero Copiar y Pegar.

Para bloquear en cualquier momento se debe escribir la sigueinte setencia:

Código:
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)


Para desbloquear (ojo, esto es importantísimo, si no hay que resetear la máquina), se digita la siguiente sentencia:

Código:
UnhookWindowsHookEx hhkLowLevelKybd


Para bloquear y ocultar la barra de tareas (TaskBar)

En otro módulo (.BAS) digitar:

Código:
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOW = 5

Public Declare Function FindWindowHandle Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long


Para que se ejecute las funciones escribir las siguientes sentencias:

Código:
   Dim hWnd As Long
   Dim Res As Long
   hWnd = FindWindowHandle("shell_traywnd", Chr(0))
   Res = ShowWindow(hWnd, SW_HIDE)


Y para desbloquear y mostrar de nuevo:

Código:
   hWnd = FindWindowHandle("shell_traywnd", Chr(0))
   Res = ShowWindow(hWnd, SW_SHOW)


Por último para minimizar todas las ventanas incluso si están en modo gráfico como juegos,

En un módulo (.BAS) digitar lo siguiente:

Código:
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Const VK_LWIN = &H5B
Public Const KEYEVENTF_KEYUP = &H2


Para que se ejecute el proceso dar las siguientes instrucciones:

Código:
   Call keybd_event(VK_LWIN, 0, 0, 0)
   Call keybd_event(&H4D, 0, 0, 0)
   Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)

Como Utilizar un ProgressBar
Una barra del progreso exhibe una barra azul creciente o que se contrae para dar la regeneración de usuario en una cierta clase de operación. Esto puede descargar un archivo del Internet o de la terminación de una tarea muy larga. La barra azul puede ser dividida en segmentos o puede ser sólida. El ProgressBar está situado en los controles comunes de Microsoft Windows así que agregar este control a su caja de herramientas que usted tiene que chascar encendido proyectos sobre la barra de menú, después chascar encendido componentes y los componentes caja aparecerá de diálogo, después enrollan abajo y localizan los controles 6 del campo común de Microsoft Windows y ponen un cheque en la caja de cheque al lado de ella y chascan encendido MUY BIEN.

* Nota: CTRL + t también abre la caja de diálogo de los componentes

Características, métodos y acontecimientos

características significativas

Movimiento en sentido vertical(Scrolling): se determina si la exhibición del progreso aparece sólida o dividida en segmentos
Negotiate: esto se determina si un control que puede ser alineado está exhibido cuando un objeto activo en la forma exhibe unos o más toolbars.
Orientación( Orientación): se determina si la orientación es horizontal o vertical
Valor(Value): el ajuste actual de la barra del progreso
Aspecto(Appearance): esto hace que la barra del progreso aparece o en 3D o plano
BorderStyle: fija el estilo de la frontera de los controles
Max, Min: fija los valores máximos y mínimos de la barra del progreso

Métodos las barras del progreso hacen que los métodos estándares de otros controles éstos incluyan el movimiento, tecleo, DblClick etcétera.


Ejemplo:

Coloque simplemente una barra del progreso en la pantalla fijada su característica mínima a 0 y su característica máxima a 100. Experimente entre las dos diversas características de Scolling del ccScrollingSmooth (normal) o del ccScrollingStandard (dividido en segmentos). Para animar la barra del progreso ponga un control del contador de tiempo(Timer) en la forma y fije su característica del intervalo a 1000 milisegundos que el Now agrega un botón de comando a la forma (el usuario chascará esto y la barra del progreso se moverá), hace que los botones de comando subtitulan dice algo como comienzo.

Primero ponga el código siguiente en el procedimiento del acontecimiento del Form Load.

Código:
Private Sub Form_Load()

      Timer1.Enabled = False
      ProgressBar1.Value = 0

End Sub


Ahora ponga el código siguiente en el procedimiento del acontecimiento del Command buttons Click

Código:
Private Sub Command1_Click()

      ProgressBar1.Value = 0
      Timer1.Enabled = True

End Sub


y finalmente el código siguiente consigue colocado en el acontecimiento del contador de tiempo de los contadores de tiempo

Código:
Private Sub Timer1_Timer()

    ProgressBar1.Value = ProgressBar1.Value + 1
    If ProgressBar1.Value >= 10 Then _
          Timer1.Enabled = False

End Sub

Como Guardar datos en el registro de Windows
Hola. Create un formulario llamado Form1, y en el pon un CheckBox, llamado Check1. Depués añade este código.

Código:
  Private Sub Form_Load()
     Check1.Value = GetSetting(App.Title, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, vbChecked)
  End Sub


Código:
  Private Sub Form_Unload(Cancel As Integer)
     SaveSetting App.Title, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, Check1.Value
  End Sub


Tendrás que hacer lo mismo con cada uno de los controles de tu formulario.
Se podría hacer incluso un procedimiento para guardar en un bucle todas las propiedades de todos los controles de un formulario, pero eso te lo dejamos investigar a vos.
en caso de que fuera un texto un label se reemplaza el codigo por las propiedades de un texto, por ejemplo

Código:
   Private Sub Form_Load()
  text1.text = GetSetting(App.Title, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, vbChecked)
  End Sub


Código:
   Private Sub Form_Unload(Cancel As Integer)
      SaveSetting App.Title, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login, text1.text
   End Sub


para una label seria igual pero con label1.caption..

Dibujar Codigo de Barras (Bar Code)
El codigo a continuación tiene un Procedimiento llamado
DrawBarCode, el cual recibe el codigo del item, la descripción del mismo y un control PictureBox, el cual contendrá el codigo de barras.

Sólo debes diseñar un form con 3 controles (2 textBox y 1 PictureBox), luego
ejecutas

Call DrawBarcode(codigo_item, Descripcion_item, PictureBox)

Código:
Sub DrawBarcode(ByVal bc_string As String, sDescripcion As String, VLPrecio as String, obj As Control)

Dim xpos!, y1!, y2!, dw%, th!, tw, new_string$
Dim bc(90) As String
Dim sAux As String
Dim I As Byte

bc(1) = "1 1221" 'pre-amble
bc(2) = "1 1221" 'post-amble
bc(48) = "11 221" 'dígitos
bc(49) = "21 112"
bc(50) = "12 112"
bc(51) = "22 111"
bc(52) = "11 212"
bc(53) = "21 211"
bc(54) = "12 211"
bc(55) = "11 122"
bc(56) = "21 121"
bc(57) = "12 121"
'Letras Mayúsculas
bc(65) = "211 12" 'A
bc(66) = "121 12" 'B
bc(67) = "221 11" 'C
bc(68) = "112 12" 'D
bc(69) = "212 11" 'E
bc(70) = "122 11" 'F
bc(71) = "111 22" 'G
bc(72) = "211 21" 'H
bc(73) = "121 21" 'I
bc(74) = "112 21" 'J
bc(75) = "2111 2" 'K
bc(76) = "1211 2" 'L
bc(77) = "2211 1" 'M
bc(78) = "1121 2" 'N
bc(79) = "2121 1" 'O
bc(80) = "1221 1" 'P
bc(81) = "1112 2" 'Q
bc(82) = "2112 1" 'R
bc(83) = "1212 1" 'S
bc(84) = "1122 1" 'T
bc(85) = "2 1112" 'U
bc(86) = "1 2112" 'V
bc(87) = "2 2111" 'W
bc(88) = "1 1212" 'X
bc(89) = "2 1211" 'Y
bc(90) = "1 2211" 'Z
'Misceláneos Caracteres
bc(32) = "1 2121" 'Espacio
bc(35) = "" '# no se puede realizar
bc(36) = "1 1 1 11" '$
bc(37) = "11 1 1 1" '%
bc(43) = "1 11 1 1" '+
bc(45) = "1 1122" '-
bc(47) = "1 1 11 1" '/
bc(46) = "2 1121" '.
bc(64) = "" '@ no se puede realizar
bc(65) = "1 1221" '*

bc_string = UCase(bc_string) 'Convertir a mayúsculas

'Dimensiones
obj.ScaleMode = 2 'Pixeles
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40) 'Espacio entre barras
If dw < 1 Then dw = 1
th = obj.TextHeight(bc_string) 'Alto texto
tw = obj.TextWidth(bc_string) 'Ancho texto
new_string = Chr$(1) & bc_string & Chr$(2) 'Agregar pre-amble, post-amble
y1 = obj.ScaleTop + 12
y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * th
obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth

'Dibujar cada caracter en el string barcode
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = bc(c)
'Dibujar cada barra
For I = 1 To Len(bc_pattern$)
Select Case Mid(bc_pattern$, I, 1)
Case " "
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
Case "1"
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'Línea
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &H0&, BF
xpos = xpos + dw
Case "2"
'Espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw
'Ancho línea
obj.Line (xpos, y1)-(xpos + 2 * dw, y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next

'Mas espacio
obj.Line (xpos, y1)-(xpos + 1 * dw, y2), &HFFFFFF, BF
xpos = xpos + dw

'Medida final y tamaño
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = 1
obj.CurrentY = 1
If VLPrecio = "0.00" Then VLPrecio = ""
If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sDescripcion) Then
sAux = ""
For I = 1 To Len(sDescripcion)
If xpos - obj.TextWidth(VLPrecio) - 10 < obj.TextWidth(sAux) Then
Exit For
Else
sAux = sAux & Mid(sDescripcion, I, 1)
End If
Next I
obj.Print sAux
Else
obj.Print sDescripcion
End If
obj.CurrentX = xpos - obj.TextWidth(VLPrecio)
obj.CurrentY = 1
obj.Print VLPrecio
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = y2 + 0.25 * th
obj.Print bc_string

'Copiar a clipboard
obj.Picture = obj.Image
Clipboard.Clear
Clipboard.SetData obj.Image, 2
End Sub

Cómo imprimir un MSFLEXGRID
Código:
Public Sub MSHFG_Print(ByVal gri As Control, cabecer As String, peu As String)
Set grid = gri
ReDim dimen(grid.Cols)
If grid.Rows = 1 Then Exit Sub
'Agafo l'amplada del grid total a imprimir
ample = 0
For x = 0 To grid.Cols - 1
grid.Col = x
If grid.CellWidth > 20 Then
If grid.CellWidth < 200 Then grid.ColWidth(x) = 200
ample = grid.CellWidth + ample
End If
dimen(x) = grid.CellWidth
Next x
grid.LeftCol = 1
'ja tinc el ample a imprimir
tppx = Printer.TwipsPerPixelX
tppy = Printer.TwipsPerPixelY
cabecera = cabecer
pie = peu
x0 = (Printer.ScaleWidth - ample) / 2
y0 = (Printer.Height - Printer.ScaleHeight) / 2
y1 = y0
Printer.CurrentY = y1
grid.Col = 0
grid.Row = 0
For Row = 0 To grid.Rows - 1
If Row = 0 Then PosCapMSHFG
'faig la ultima linea del grid si ha acabat sense cuadricular
If Printer.ScaleHeight - 1500 < y1 Then 'finalitzo pag i poso capçelera.
If cuadro = True Then Printer.Line (x0, y1)-(x0 + ample, y1), vbBlack, B
Printer.CurrentY = Printer.ScaleHeight - 500
Printer.CurrentX = x0
Printer.Print pie
Printer.CurrentX = Printer.ScaleWidth - 1000
Printer.Print "Pág " & You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login
Printer.NewPage
PosCapMSHFG
End If
ImpLinMSHFG

Next
'faig la ultima linea del grid si ha acabat sense cuadricular
If cuadro = True Then Printer.Line (x0, y1)-(x0 + ample, y1), vbBlack, B
Printer.CurrentY = Printer.ScaleHeight - 500
Printer.CurrentX = x0
Printer.Print pie
Printer.CurrentX = Printer.ScaleWidth - 1000
Printer.Print "Pág " & You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login
Printer.EndDoc
End Sub


Private Sub ImpLinMSHFG()
alt = grid.RowHeight(Row)

Printer.FillStyle = 1 'solido 0
Printer.CurrentX = x0
Printer.CurrentY = y1 'printer.CurrentY - tppy
If cuadro Then
Printer.Line -Step(ample + tppx, alt + tppy), vbBlack, B
Else
Printer.Line (x0 + ample, y1)-(x0 + ample, y1 + alt + tppy), vbBlack, B
End If
cuadro = Not cuadro
For Col = 0 To grid.Cols - 1
If Col = 0 Then
x1 = x0 'COMENÇO PER L'ESQUERRA
'alt = printer.FontSize * tppy * 5
Else
x1 = x1 + dimen(Col - 1)
End If
If dimen(Col) < 20 Then Col = Col + 1
If dimen(Col) > 20 Then
Printer.CurrentX = x1 + tppx
Printer.CurrentY = y1 '+ tppy
Printer.Line (x1, y1 + tppy)-(x1, alt + y1 - tppy), vbBlack, B
Printer.CurrentX = x1 + 30 / tppx
Printer.CurrentY = y1 '+ tppy
texte = grid.TextArray(grid.Cols * Row + Col)
Do While Printer.TextWidth(texte) > dimen(Col) And Len(texte) > 0
texte = Left(texte, Len(texte) - 1)
punts = True
Loop
If punts = True And Len(texte) > 0 Then texte = Left(texte, Len(texte) - 2) & "..."
punts = False
If grid.ColAlignment(Col) > 5 Then Printer.CurrentX = Printer.CurrentX + dimen(Col) - Printer.TextWidth(texte) - 30 / tppx
If grid.ColAlignment(Col) >= 3 And grid.ColAlignment(Col) <= 5 Then Printer.CurrentX = Printer.CurrentX + (dimen(Col) - Printer.TextWidth(texte)) / 2

Printer.Print texte
End If
Next
y1 = y1 + grid.RowHeight(Row) '- tppy 'y + alto de la fila actual

End Sub

Public Sub PosCapMSHFG()
Printer.CurrentY = y0
Printer.FontSize = 20
Printer.ForeColor = vbBlue
Printer.FontBold = True
Printer.CurrentX = (Printer.Width - Printer.ScaleWidth) + (Printer.ScaleWidth - Printer.TextWidth(cabecera)) / 2
Printer.Print cabecera
Printer.FontSize = 8.25
Printer.ForeColor = vbBlack
Printer.FontBold = False
y1 = Printer.CurrentY + 300 'separaciò amb el titol
'Row = trow
'grid.Row = Row
'grid.Col = 0
For Col = 0 To grid.Cols - 1
'grid.Col = Col
If Col = 0 Then
x1 = x0 'COMENÇO PER L'ESQUERRA
'alt = printer.FontSize * tppy * 5
Else
x1 = x1 + dimen(Col - 1)
End If
If dimen(Col) < 20 Then Col = Col + 1
'If grid.Col = 9 Or grid.Col = 11 Then x1 = x1 + 400
'grid.Col = Col
If dimen(Col) > 20 Then
Printer.CurrentX = x1 + tppx
Printer.CurrentY = y1 '+ tppy
Printer.Line (x1, y1 + tppy)-(x1, alt + y1 - tppy), vbBlack, B
Printer.CurrentX = x1 + 15 / tppx
Printer.CurrentY = y1 '+ tppy
texte = grid.TextArray(Col)
Do While Printer.TextWidth(texte & "...") > dimen(Col) And Len(texte) > 0
texte = Left(texte, Len(texte) - 1)
punts = True
Loop
If punts = True And Len(texte) > 0 Then texte = Left(texte, Len(texte) - 2) & "..."
punts = False
Printer.CurrentX = Printer.CurrentX + (dimen(Col) - Printer.TextWidth(texte)) / 2
Printer.Print texte
End If
Next
y1 = y1 + grid.RowHeight(Row) '- tppy 'y + alto de la fila actual
cuadro = True
If Row = 0 Then Row = 1

End Sub

Compactar una base de datos, usando código VB
Este es el código que uso para compactar las bases de datos. Cosa que suelo hacer bastante a menudo, sobre todo en las que uso en la empresa, que cambian a diario.
Por aquello de la seguridad, mantengo dos copias: la anterior y la última. Más vale prevenir. Nunca se sabe cuando se cortará la luz o se quedará colgado el equipo... así que, me curo en salud.

Código:

'Cerrar la base (esto sólo si la tienes abierta...)
Db.Close
'Liberar memoria y "desligarla"
Set Db = Nothing
'
'Tomar el nombre sin la extensión
sTmp = ""
i = InStr(NombreBase, ".")
If i Then
   p = i - 1
Else
   p = Len(NombreBase)
End If
sTmp = Left$(NombreBase, p)
'Buscar \, para tomar el directorio (path)
For i = p To 1 Step -1
   If Mid$(NombreBase, i, 1) = "\" Then
      sTmp = Left$(NombreBase, i)
      Exit For
   End If
Next
If Right$(sTmp, 1) <> "\" Then
   sTmp = sTmp & "\"
End If
'Todo este proceso es para estar seguro de que se quede una copia
'en caso de que falle la compactación...
dBaseTmp = sTmp & "~dBase2.mdb"
If Len(Dir$(dBaseTmp)) Then Kill dBaseTmp
If Len(Dir$(sTmp & "~dBase1.mdb")) Then Kill sTmp & "~dBase1.mdb"
'Esta es la madre del cordero, se pueden usar otras "versiones", es cuestión de adecuarte.
CompactDatabase NombreBase, dBaseTmp, dbLangSpanish, dbVersion20
'Guardar una copia de como estaba antes
Name NombreBase As sTmp & "~dBase1.mdb"
'Esta es la base ya compactada, así que asignar el nombre
Name dBaseTmp As NombreBase
'Borrar los ficheros LDB
If Len(Dir$(sTmp & "*.ldb")) Then Kill sTmp & "*.ldb"

 Hacer sonar un fichero Wav o Midi
Insertar el siguiente código en un módulo:

Código:
Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Insertar un botón en el formulario y escribir el siguiente código:
Private Sub Command1_Click()
   iResult = mciExecute("Play c:\windows\ringin.wav")
End Sub

 Leer y escribir un fichero Ini
Declaraciones generales en un módulo:

Código:
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As _
String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As _
Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'Leer en "Ejemplo.Ini":
Private Sub Form_Load()
   Dim I As Integer
   Dim Est As String
   Est = String$(50, " ")
   I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini")
   If I > 0 Then
      MsgBox "Tu Nombre es: " & Est
   End If
End Sub
'Escribir en "Prueba.Ini":
Private Sub Form_Unload(Cancel As Integer)
   Dim I As Integer
   Dim Est As String
   Est = "Ejemplo - Apartado"
   I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini")
End Sub
'Leer en "Ejemplo.Ini":
Private Sub Form_Load()
   Dim I As Integer
   Dim Est As String
   Est = String$(50, " ")
   I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini")
   If I > 0 Then
      MsgBox "Tu Nombre es: " & Est
   End If
End Sub
'Escribir en "Prueba.Ini":
Private Sub Form_Unload(Cancel As Integer)
   Dim I As Integer
   Dim Est As String
   Est = "Ejemplo - Apartado"
   I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini")
End Sub


(Nota: si I=0 quiere decir que no existe información en la línea de fichero Ini a la
que hacemos referencia. El fichero "Ejemplo.Ini" se creará automáticamente).

Apagar el equipo, reiniciar Windows, reiniciar el Sistema
Añadir tres botones a un formulario y escribir lo siguiente en el código del formulario:

Código:
Private Declare Function ExitWindowsEx& Lib "user32" (ByVal
uFlags&, ByVal dwReserved&)
Private Sub Command1_Click()
Dim i as integer
i = ExitWindowsEx(1, 0&) 'Apaga el equipo
End Sub
Private Sub Command2_Click()
Dim i as integer
i = ExitWindowsEx(0, 0&) 'Reinicia Windows con nuevo usuario
End Sub
Private Sub Command3_Click()
Dim i as integer
i = ExitWindowsEx(2, 0&) 'Reinicia el Sistema
End Sub

Convertir un texto a mayúsculas o minúsculas
Código:
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

Usar IF THEN ELSE ENDIF en una misma línea
Insertar un CommandButton y un TextBox y escribir el siguiente código:

Código:
Private Sub Command1_Click()
Dim I As Integer
Dim A As String
I = 3
A = IIf(I <> 1, "True", "False")
Text1.Text = A
End Sub


Una variante del mismo codigo:
Insertar un CommandButton y un TextBox y escribir el siguiente código:

Código:
Private Sub Command1_Click()
Dim I As Integer
Dim A As String
I = 3
If I <> 1 Then A = "True" Else A = "False"
Text1.Text = A
End Sub

Como pasar de un texto a otro usando Enter
Insertar tres TextBox y escribir el siguiente código:

Código:

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
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 código:

Código:

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Como dar vuelta a un texto
Vamos a imaginar que por el motivo que sea deseamos invertir el orden de los caracteres de un texto. Imaginemos que el texto lo tenemos en una variable llamada Texto y almacenamos el contenido de la caneda texto al inverso en la variable Otxet. Por ejemplo: si tenemos el texto Casa obtendremos asaC.

Para ello deberíamos escribir el siguiente código:

Código:

For Contador = Len(Texto) To 1 Step -1

Otxet = Otxet & Mid (Texto, Contador, 1) 
Next Contador

Como ingresar solo numeros en un campo de texto
Código:

  If ((KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii < 44 Or KeyAscii > 44)) Then
       If (KeyAscii <> 8) Then KeyAscii = 0
    End If

Como verificar si un fichero existe
Código:

Public Sub  VerificarFichero(sNombreFichero As String)
On Error Resume Next
Open sNombreFichero For Input As #1
If Err Then
MsgBox ("El fichero " & sNombreFichero & " no existe.")
Exit Sub
End If
Close #1
End Sub

en un botton:

VerificarFichero "c:\prueba.txt"

Código:

Dim Archivo As String
Archivo = "C:\MiTexto.txt"
If Dir(Archivo, vbArchive) = "" Then
MsgBox "El Fichero No Existe"
End If