• Fuentes

 #210397  por ANTRAX
 
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: Seleccionar todo
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.
 #210399  por ANTRAX
 
Imprimir un RichTextBox con su formato original.
Código: Seleccionar todo
Private Sub Command1_Click()
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] :
Código: Seleccionar todo
Private Sub Form_Load() Dim LineWidth As Long Me.Caption = "Rich Text Box Ejemplo de Impresion" Command1.Move 10, 10, 600, 380 Command1.Caption = "&Imprimir" RichTextBox1.SelFontName = "Verdana, Tahoma, Arial" RichTextBox1.SelFontSize = 10 LineWidth = WYSIWYG_RTF(RichTextBox1, 1440, 1440) Me.Width = LineWidth + 200End Sub Private Sub Form_Resize() RichTextBox1.Move 100, 500, Me.ScaleWidth - 200, Me.ScaleHeight - 600End Sub Private Sub Command1_Click() PrintRTF RichTextBox1, 1440, 1440, 1440, 1440End Sub Crear un módulo 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.Print Space(1)
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
Printer.Print Space(1)
fr.hDC = Printer.hDC
fr.hDCTarget = Printer.hDC
Loop
Printer.EndDoc
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0))
End Sub
 #210400  por ANTRAX
 
Un array permite referirse a una serie de elementos del mismo tipo por un mismo nombre y referenciar un único elemento de la serie utilizando un índice. Visual Basic, igual que sus predecesores, permite definir arrays de variables de una o más dimensiones y de cualquier tipo de datos (tipos fundamentales y tipos definidos por el usuario), e introduce una nueva clase de arrays de controles, necesarios para escribir menús, para crear nuevos controles en tiempo de ejecución o para hacer que una serie de controles tengan asociado un mismo procedimiento para cada tipo de suceso.

Arrays de variables

Los arrays discutidos en este apartado permiten referirse a una serie de variables por un mismo nombre y acceder individualmente a cada una de ellas utilizando un índice (variables subindicadas). Este tipo de arrays tiene que declararse en el código y pueden tener una o más dimensiones.

Arrays estáticos

Para declarar un array estático (array con un número fijo de elementos), Visual Basic hace tres consideraciones importantes:

Para declarar un array global, hágalo en la sección de declaraciones de un módulo utilizando la sentencia Public.
Para declarar un array a nivel de un módulo, hágalo en la sección de declaraciones del módulo utilizando la sentencia Public o Dim.
Para declarar un array local a un procedimiento, utilice la sentencia Dim o Static dentro del propio procedimiento.
A diferencia de otras versiones de Basic, Visual Basic no permite declarar implícitamente un array. Un array tiene que ser declarado explícitamente, y los índices del mismo deben estar en el rango (-2.147.483.648 a 2.147.483.647).

A continuación se muestran algunos ejemplos:

Dim Array_A(19) As String

Este ejemplo declara un array de una dimensión, Array_A, con veinte elementos, Array_A(0), Array_A(1),..., Array_A(19), cada uno de los cuales permite almacenar una cadena de caracteres de longitud variable.

Dim Array_B(3, 1 To 6) As Integer

Este ejemplo declara un array de dos dimensiones, Array_B, con 4x6 elementos, Array_B(0,1),..., Array_B(3,6), de tipo entero.

Static Array_C(1 To 5, 1 To 5) As Integer

Este ejemplo declara un array de dos dimensiones, Array_C, con 5x5 elementos, Array_C(1,1),..., Array_C(5,5), de tipo entero.

Public Array_D(1 To 12) As String *60

Este ejemplo declara un array de una dimensión, Array_D, con doce elementos, Array_D(1),..., Array_D(12), cada uno de los cuales permite almacenar una cadena de caracteres de longitud fija (60 caracteres).

Arrays Dinámicos

Cuando las dimensiones de un array no son siempre las mismas, la mejor forma de especificarlas es mediante variables. Un array declarado de esta forma es un array dinámico. El espacio necesario para un array estático se asigna al iniciarse el programa y permanecerá fijo. El espacio para un array dinámico será asignado en cualquier momento durante la ejecución.

Para crear un array dinámico.

Declare el array en la sección de declaraciones de un módulo con una sentencia Public si lo quiere global con Private o Dim si lo quiere s nivel del módulo, o en un procedimiento con Static o Dim si lo quiere local. Para especificar que el array va a ser dinámico deje la lista de dimensiones vacía. Por ejemplo:

Dim Array_A()

Asigne el número actual de elementos con la sentencia ReDim.

ReDim Array_A(N+1)

La sentencia ReDim puede aparecer solamente en un procedimiento y permite cambiar el número de elementos del array, no el número de dimensiones.

Por ejemplo, si declaramos el array_A a nivel de un módulo.

Private Array_A() as Integer

Para asignarle espacio al array utilizamos:

ReDim Array_A(5)

Cada vez que se ejecuta la sentencia ReDim, todos los valores almacenados en el array se pierden. Cuando le interese cambiar el tamaño del array conservando los valores del array, ejecute ReDim con la palabra clave Preserve. Por ejemplo, supongamos un Array_A de dos dimensiones. La sentencia será:

ReDim Preserve Array_A(8)
 #210401  por ANTRAX
 
Dos ejemplos de cómo restar fechas y horas.
Para saber los segundos entre dos horas o los días entre dos fechas.

Crea un form con los siguientes controles, dejale los nombre por defecto.
4 TextBox
2 Labels
2 Commands
Distribuyelos para que los dos primeros TextoBoxes estén con el primer label y command, lo mismo con el resto.
Añade lo siguiente al form y pulsa F5

'Ejemplo de prueba para restar fechas y horas
Código: Seleccionar todo
Option Explicit


Private Sub Command1_Click()
Dim t0 As Variant, t1 As Variant

'Text1 Tendrá una fecha anterior
'Text2 tendrá la nueva fecha
t0 = DateValue(Text1)
t1 = DateValue(Text2)
Label1 = t1 - t0

End Sub


Private Sub Command2_Click()
Dim t0 As Variant, t1 As Variant

'Text3 Tendrá una hora anterior
Text4 = Format(Now, "hh:mm:ss")
t0 = Format(Text3, "hh:mm:ss")
t1 = Format(Text4, "hh:mm:ss")
Label2 = Format(TimeValue(t1) - TimeValue(t0), "hh:mm:ss")

End Sub


Private Sub Form_Load()
'Para probar la diferencia de fechas
Text1 = DateValue(Now)
Text2 = DateValue(Now + 10)
'
'Para probar la diferencia de horas
Text3 = Format(Now, "hh:mm:ss")
Text4 = Format(Now, "hh:mm:ss")

Command1_Click
Command2_Click
End Sub
 #210402  por ANTRAX
 
usa la API ExitWindowsEx

Copia todo este codigo en un modulo, despues en tu formulario, o donde lo necesites unicamente llama a las funciones necesarias:
Código: Seleccionar todo
Option Explicit

Public Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Public Const TOKEN_QUERY As Long = &H8
Public Const SE_PRIVILEGE_ENABLED As Long = &H2

Public Const EWX_LOGOFF As Long = &H0
Public Const EWX_SHUTDOWN As Long = &H1
Public Const EWX_REBOOT As Long = &H2
Public Const EWX_FORCE As Long = &H4
Public Const EWX_POWEROFF As Long = &H8
Public Const EWX_FORCEIFHUNG As Long = &H10 '2000/XP only

Public Const VER_PLATFORM_WIN32_NT As Long = 2
Public uflags As Long
Public success As Long

'TIPO DE DATOS PARA LAS APIS
Public Type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
End Type

Public Type LUID
   dwLowPart As Long
   dwHighPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
   udtLUID As LUID
   dwAttributes As Long
End Type

Public Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   laa As LUID_AND_ATTRIBUTES
End Type

'DECLARACION DE LAS APIS A USAR
Public Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As Any, ReturnLength As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

'FUNCION PARA SABER QUE SISTEMA OPERATIVO CORRE
'returns True if running Windows NT,
'Windows 2000, Windows XP, or .net server
Public Function IsWinNTPlus() As Boolean
   #If Win32 Then
      Dim OSV As OSVERSIONINFO
      OSV.OSVSize = Len(OSV)
      If GetVersionEx(OSV) = 1 Then
         IsWinNTPlus = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And (OSV.dwVerMajor >= 4)
      End If
   #End If
End Function

'FUNCION PARA DAR LOS PERMISOS NECESARIOS
Public Function EnableShutdownPrivledges() As Boolean
   Dim hProcessHandle As Long
   Dim hTokenHandle As Long
   Dim lpv_la As LUID
   Dim token As TOKEN_PRIVILEGES
   
   hProcessHandle = GetCurrentProcess()
   
   If hProcessHandle <> 0 Then
   
     'open the access token associated
     'with the current process. hTokenHandle
     'returns a handle identifying the
     'newly-opened access token
      If OpenProcessToken(hProcessHandle, _
                        (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _
                         hTokenHandle) <> 0 Then
   
        'obtain the locally unique identifier
        '(LUID) used on the specified system
        'to locally represent the specified
        'privilege name. Passing vbNullString
        'causes the api to attempt to find
        'the privilege name on the local system.
         If LookupPrivilegeValue(vbNullString, _
                                 "SeShutdownPrivilege", _
                                 lpv_la) <> 0 Then
         
           'TOKEN_PRIVILEGES contains info about
           'a set of privileges for an access token.
           'Prepare the TOKEN_PRIVILEGES structure
           'by enabling one privilege.
            With token
               .PrivilegeCount = 1
               .laa.udtLUID = lpv_la
               .laa.dwAttributes = SE_PRIVILEGE_ENABLED
            End With
   
           'Enable the shutdown privilege in
           'the access token of this process.
           'hTokenHandle: access token containing the
           '  privileges to be modified
           'DisableAllPrivileges: if True the function
           '  disables all privileges and ignores the
           '  NewState parameter. If FALSE, the
           '  function modifies privileges based on
           '  the information pointed to by NewState.
           'token: TOKEN_PRIVILEGES structure specifying
           '  an array of privileges and their attributes.
           '
           'Since were just adjusting to shut down,
           'BufferLength, PreviousState and ReturnLength
           'can be passed as null.
            If AdjustTokenPrivileges(hTokenHandle, _
                                     False, _
                                     token, _
                                     ByVal 0&, _
                                     ByVal 0&, _
                                     ByVal 0&) <> 0 Then
                                     
              'success, so return True
               EnableShutdownPrivledges = True
   
            End If  'AdjustTokenPrivileges
         End If  'LookupPrivilegeValue
      End If  'OpenProcessToken
   End If  'hProcessHandle
End Function

'FUNCION PARA REINICIAR EL SISTEMA
Public Sub ReiniciarPc()
    uflags = EWX_REBOOT Or EWX_FORCE
    If IsWinNTPlus() Then
        success = EnableShutdownPrivledges()
        If success Then Call ExitWindowsEx(uflags, 0&)
    Else
        '9x system, so just do it
        Call ExitWindowsEx(uflags, 0&)
    End If
End Sub


'FUNCIONA PARA APAGAR EL SISTEMA
Public Sub ApagarPc()
    uflags = EWX_POWEROFF Or EWX_FORCE
    If IsWinNTPlus() Then
        success = EnableShutdownPrivledges()
        If success Then Call ExitWindowsEx(uflags, 0&)
        'Shell "shutdown -r -t 0"
    Else
        '9x system, so just do it
        Call ExitWindowsEx(uflags, 0&)
    End If
End Sub

'FUNCION PARA SALIR DEL SISTEMA
Public Sub SalirSistema()
    uflags = EWX_LOGOFF Or EWX_FORCE
    If IsWinNTPlus() Then
        success = EnableShutdownPrivledges()
        If success Then Call ExitWindowsEx(uflags, 0&)
        'Shell "shutdown -r -t 0"
    Else
        '9x system, so just do it
        Call ExitWindowsEx(uflags, 0&)
    End If
End Sub
y para usarlas nomas asi:
Código: Seleccionar todo
'PARA REINICIAR EL SISTEMA
Call ReiniciarPc

'PARA APAGAR EL ORDENADOR
Call ApagarPc
 #210404  por ANTRAX
 
En el evento QueryUnload del formulario colocar un codigo como el siguiente:
Código: Seleccionar todo
 Private EnabledClose As Boolean 
Private Sub Form_Unload(Cancel As Integer)
If Not EnabledClose Then
	Cancel = -1
End If
End Sub
'Suponiendo que se cierra con un Botón
Private Sub Command1_Click()
EnabledClose = True
Unload Me
End Sub 
Esto no impide que se haga Unload Me controlado por un boton o lo que sea.
 #210406  por ANTRAX
 
Pregunta:
La pregunta es la siguiente: No sabemos como crear textbox y
listbox (o algo semejante para almacenar texto) en tiempo de ejecución (objeto)
sin que tenga límite en cuanto al número de objetos, es decir, en
este caso de textbox y listbox que se puedan crear.

Respuesta:

Para crear controles en tiempo de ejecución, con el VB6 hay otras posibilidades, debes tener esos controles en un array, como mínimo deberás tener uno, a partir de ahí, simplemente usando LOAD nombreControl(numeroDeElemento), tendrás nuevos controles.

Un ejemplo:
Crea un nuevo proyecto, añade un label y un textbox.
Selecciona el label, en la propiedad Index, escribe CERO, de esta forma tendrás un array creado.
Haz lo mismo con el TextBox.

Ahora escribe esto en el evento Load de formulario, se crearán nuevos controles.
Es importante notar que los nuevos controles creados tienen la propiedad Visible a FALSE, por tanto no serán visibles salvo que se cambie el estado a TRUE.

Veamos el código de ejemplo que permitirá crear controles, posicionarlos debajo de los anteriores y si se pulsa en el botón cmdElimir, eliminará el último que se haya creado...
Código: Seleccionar todo
'
'Ejemplo de creación de controles en tiempo de ejecución
Option Explicit
 
'Llevará la cuenta de los controles creados
Private numControles As Long
 
 
Private Sub cmdCrear_Click()
    'Crear un nuevo control de cada tipo
 
    'numControles está declarada a nivel de módulo
    numControles = numControles + 1
    'Crear los controles
    Load Label1(numControles)
    Load Text1(numControles)
 
    'Posicionarlos y hacerlos visibles
    With Label1(numControles)
        .Visible = True
        .Top = Label1(numControles - 1).Top + .Height + 120
        .Caption = "Label1(" & numControles & ")"
    End With
    With Text1(numControles)
        .Visible = True
        .Top = Text1(numControles - 1).Top + .Height + 60
        .Text = "Text1(" & numControles & ")"
    End With
End Sub
 
 
Private Sub cmdEliminar_Click()
    'Eliminar un elemento de cada control anteriormente creado
 
    'El control CERO no se puede eliminar
    If numControles > 0 Then
        'Descargarlos de la memoria
        Unload Label1(numControles)
        Unload Text1(numControles)
        numControles = numControles - 1
    End If
End Sub
 
 
Private Sub Form_Load()
  'Por defecto creamos un control de cada array:
    'un Label y un Textbox
 
    cmdCrear_Click
End Sub
 #210407  por ANTRAX
 
rutina que le permite cambiar el color de las columnas de un MsFlexGrid
Hay que pasarle el nombre del MSFLEXGRID y el valor RGB de color
esta rutinas se tiene que colocar en un BAS
Código: Seleccionar todo
  Public Sub MSFlexGridColors(ColorGrid As MSFlexGrid, R As  Integer, G As Integer, B As Integer)

  	For  j = 0 To ColorGrid.Cols - 1

  		For  i = 1 To ColorGrid.Rows - 1

  			 If i / 2 <> Int(i / 2) Then

  				 ColorGrid.Col = j

  				 ColorGrid.Row = i

  				 ColorGrid.CellBackColor = RGB(R, G, B)

  			 End If

  		Next  i

  	 Next j

  End Sub
 #210409  por ANTRAX
 
Bueno, ahí va: en algunas ocasiones me gusta que los bordes de la ventana se vean de forma "normal", es decir como si se pudiese cambiar el tamaño, pero no me gusta que lo puedan cambiar, así que lo que he hecho en estas ocasiones es simplemente conservar el tamaño inicial de la ventana (el que tiene al cargarse) y cuando el usuario decide cambiarle el tamaño, no permitirselo y volver al que tenía inicialemente.

Aquí tienes todo el código necesario:
Código: Seleccionar todo
'--------------------------------------------------------------
'Prueba para no cambiar el tamaño de una ventana con
'bordes dimensionables                              
'--------------------------------------------------------------
Option Explicit

'Tamaño inicial del Form
Dim iH As Integer
Dim iW As Integer


Private Sub Form_Load()
    'Guardar el tamaño inicial
    iH = Height
    iW = Width
End Sub


Private Sub Form_Resize()
    'Sólo comprobar si el estado es Normal
    If WindowState = vbNormal Then
        'Si se cambia la altura
        If Height <> iH Then
            Height = iH
        End If
        'Si se cambia el ancho
        If Width <> iW Then
            Width = iW
        End If
    End If
End Sub
 #210410  por ANTRAX
 
Una forma de esperar un número determinado de segundos.
Código: Seleccionar todo
'Si se quiere usar de forma GLOBAL, insertarlo en un Módulo BAS y declararlo como público

Private Sub Wait(ByVal nSec As Integer)
    'Esperar un número de segundos
    Dim t1 As Date, t2 As Date

    t1 = Second(Now)
    t2 = t1 + nSec
    Do
        DoEvents
    Loop While t2 > Second(Now)
End Sub

 #210412  por ANTRAX
 
Cuando quieras que el Visual Basic "ignore" los errores que se produzcan en tu aplicación o en parte de ella, usa:

On Error Resume Next

Esto hará que si se produce un error, se continúe ejecutando el código como si nada hubiese ocurrido.
Por supuesto que la recomendación es que compruebes si se ha producido un error, ya que no es bueno dejar que los errores ocurran sin más.
Para ello tendrás que chequear el valor de la propiedad Number del objeto Err, (que al ser la propiedad por defecto no es necesario especificarla), si ese valor es cero quiere decir que no se ha producido un error; veamos un ejemplo:
Código: Seleccionar todo
On
Código: Seleccionar todo
Local Error Resume Next

    ' Error 13 producirá un error de tipos (Type Mismatch)
    Error 13

If Err.Number Then
    MsgBox "Se ha producido el siguiente error:" & vbCrLf & _
            Err.Number & ", " & Err.Description
End If
Pero si haces esto, procura hacer un poco de limpieza... ya que, si desde este procedimiento llamas a otros procedimientos que a su vez tienen la instrucción On Error Resume Next y no has "limpiado" el valor del número del error... cualquier comprobación que hagas de ese valor dará como resultado que se muestre el mensaje.
Veamos un par de ejemplos:
Para crear el programa de pueba, crea un nuevo proyecto, añade tresd botones (Command1, Command2 y Command3), y pega este código:
Código: Seleccionar todo
Private Sub Command1_Click()
Código: Seleccionar todo

    ' Ejemplo para detectar errores en Visual Basic
    Dim i As Integer
    
    On Local Error Resume Next
    
    i = MsgBox("Pulsa SI para producir un error en este evento," & vbCrLf & _
                "pulsa en NO para llamar al procedimiento Command2_Click" & vbCrLf & _
                "pulsa en Cancelar para llamar al procedimiento Command3_Click", vbYesNoCancel)
    
    If i = vbYes Then
        ' Error 13 producirá un error de tipos (Type Mismatch)
        Error 13
    ElseIf i = vbNo Then
        ' El error producido en el procedimiento Command2 está controlado,
        ' por tanto no se mostrará el mensaje del final
        Command2_Click
    Else
        ' Esto producirá un error en Command3, pero se detectará aquí
        Command3_Click
    End If
    
    If Err Then
        MsgBox "Se ha producido el siguiente error:" & vbCrLf & _
                Err.Number & ", " & Err.Description, , "En Command1_Click"
    End If
    
End Sub


Private Sub Command2_Click()
    On Local Error Resume Next
    
    ' Error 76, (Path not found)
    Error 76
    
    If Err Then
	' Este error está comprobado dentro de este procedimiento, por tanto no mostrará nada
    End If
    
    ' Limpiamos el valor del error
    Err = 0
End Sub


Private Sub Command3_Click()
    
    ' Este procedimiento produce un error número 5
    Error 5
    
    ' Este mensaje NUNCA se mostrará
    MsgBox "El valor de Err.Number es: " & Err.Number & vbCrLf & _
           "Aquí no se notará que se ha producido un error..." & vbCrLf, , "En Command3_Click"
    
End Sub

Veamos que es lo que hace este código y porqué.

Cuando pulses en el Command1 te mostrará un mensaje pidiendote que selecciones el tipo de prueba que quieres hacer, para probar cada una de ellas, tendrás que pulsar varias veces en ese botón, una para cada una de las tres posibilidades.

Si pulsas en "SI", el error se producirá en este mismo evento y el mensaje del final nos indicará que se ha producido el error número 13.

Cuando pulses en "NO", se llamará al procedimiento Command2_Click en el que se produce un error 76, pero que el propio procedimiento se encarga de gestionar y "limpiar", por tanto, no ocurrirá, al menos aparentemente, nada.

Por último, al pulsar en "Cancelar", se llama al procedimiento Command3_Click, el cual produce el error 5, pero no detecta los errores; pero como el Visual Basic "sabe" que aún hay una rutina "interceptadora" de errores en funcionamiento, la del Command1, deja de ejecutar el código erróneo y vuelve a la siguiente instrucción que haya en el procedimiento Command1...

Después de estas tres pruebas, pulsa en el Command2. Nada ocurre, ya que el código detecta los posibles errores.

Cuando pulses en el Command3, verás que el Visual Basic se detiene mostrandonos una ventana de error, esto ocurre porque no hay ninguna rutina de detección de errores en funcionamiento y cuando no la hay... el Visual Basic nos muestra la suya propia y detiene el programa.

Ahora cambia el código del Command3_Click por este otro:
Código: Seleccionar todo
 
Private Sub Command3_Click()
    
    On Local Error Resume Next
    
    ' Este procedimiento produce un error número 5
    Error 5
    
    ' Ahora si que se mostrará este mensaje
    MsgBox "El valor de Err.Number es: " & Err.Number & vbCrLf & _
           "Aquí no se notará que se ha producido un error..." & vbCrLf, , "En Command3_Click"
    
End Sub
Como verás, al no "limpiar" el valor de la propiedad Err.Number, el valor se mantiene; y a pesar de que se haya detectado el error en ese evento, al volver de nuevo al código del Command1, se mostrará el mensaje de que hay error... y además el mensaje que tenemos en el evento Command2_Click, el cual antes no se mostraba.



Resumiendo:

Si detectas los errores con Resume Next, acostumbrate a dejar el valor de Err.Number a cero antes de que acabe y/o antes de salir del procedimiento. Recuerda que para salir de un procedimiento puedes usar Exit Sub, Exit Function o Exit Property.

También debes saber que, cuando acaba un procedimiento, la rutina que gestiona los errores también acaba, pero, como has podido comprobar, el valor del error permanece asignado.
 #210415  por ANTRAX
 
Código: Seleccionar todo
Private Sub Form_Activate()
Webbrowser1.Navigate "http://login.passport.net/uilogin.srf?id=2" 'Este es hotmail debes poner la dirección exacta
End Sub

Private Sub Command1_Click()
Do Until Webbrowser1.ReadyState = READYSTATE_COMPLETE
  DoEvents
Loop
On Error Resume Next
Webbrowser1.Document.Form1.login.Value = "[email protected]"
Webbrowser1.Document.Form1.passwd.Value = "password"
Webbrowser1.Document.Form1.submit
End Sub
Solo debes tener en cuenta el nombre de la caja de texto y el del formulario, en gmail sería :
Código: Seleccionar todo
Webbrowser1.Document.Forms(0).email.Value = "[email protected]" 'por ejemplo...
 #210417  por ANTRAX
 
Esta es una función que nos permite ejecutar Cualquier Archivo siempre y cuando existe un programa para abrir dicho archivo.
Ademas ejecuta los .exe y abre directorios o unidades.
Ejemplo
Ponemos Direccion="D:/" ABRIRA UNA BENTANA con el contenido de D
Ponemos Direccion="D:/PEPE" ABRIRA UNA BENTANA con el contenido de pepe
Ponemos Direccion="D:/PEPE/doci.doc" ABRIRA doci.doc sin existe un programa para abrirlo como es elWord.

Escriba este codigo en el formulario en General:

Public Sub EjecutarArchivos(Direccion As String)
On Error GoTo error
ret = Shell("rundll32.exe url.dll,FileProtocolHandler " & (Direccion), 1)
Exit Sub
error: MsgBox Err.Description, vbExclamation, "Error de Ejecución"
End Sub

para ejecutar solo tenemos que poner
La función
ejemplo
EjecutarArchivos "c:\nota.txt"
  • 1
  • 2
  • 3
  • 4
  • 5
  • 9