Mis Utilidades

Diálogo para Buscar y Reemplazar
revisado y mejorado (espero)

Fecha: 8/Sep/97

No voy a empezar con una E, no sea que le coja el gustillo...
Esta es la última "versión" que tengo del diálogo para buscar y reemplazar.
La mejora, aparte de añadirle un par de checkbox para poder seleccionar palabra completa y la dirección de la búsqueda, está en que ahora las rutinas de búsqueda se realizan en el mismo código, así se puede usar en cualquier programa sin tener que "implementar" esas rutinas... de esta forma si mejoras la rutina de búsqueda, servirá para cualquier aplicación que la utilice... ¿quién hablaba de código reutilizable sólo por medio de programación orientada a objetos...?

Este es el nuevo look del formulario:

 

Para usar las nuevas opciones de los CheckBoxes, deberás poner esto en el form_unload:

    iFFCompleta = chkCompleta.Value
    iFFAtras = chkDireccion.Value

De esta forma se asignan esas variables, que están declaradas en el módulo que acompaña a este form, después pondré el listado, lo que hay que tener en cuenta es que el form que quiera usar las rutinas que se incluyen en el módulo debe tener un menú de edición con estas opciones:

 

Esta sería una forma de usarlo, no sólo para aprovechar las rutinas incluidas, sino usando otras, por ejemplo para el caso de buscar en uan base de datos:

iFFAtras = True
If gsBuscar(sBuscar, cFFAc_Buscar + cFFAc_Atras, "Buscar datos") > cFFAc_IDLE Then
    sBuscar = Trim$(sBuscar)
    If Len(sBuscar) Then

Este es el código completo del Form y del módulo:

'----------------------------------------------------
'Form genérico para diálogo Buscar/Reemplazar
'
'Nuevas opciones:    6/Sep/97   Palabra completa y dirección
'
'©Guillermo Som Cerezo, 1996-97
'----------------------------------------------------
Option Explicit

Const NumeroMaximoDeItems = 200
Dim bBuscandoEnCombo As Boolean
Dim iPosCombo As Integer


Private Sub cmdCancel_Click()
    ActualizarCombo
    
    iFFAccion = cFFAc_Cancelar
    Unload Me
End Sub


Private Sub cmdFindNext_Click()
    ActualizarCombo
    sFFBuscar = txtFind.Text
    sFFPoner = ""
    
    iFFAccion = cFFAc_BuscarSiguiente
    Unload Me
End Sub


Private Sub cmdReplace_Click()
    ActualizarCombo
    sFFBuscar = txtFind.Text
    sFFPoner = txtReplace.Text
    If Len(sFFPoner) = 0 Then
        iFFAccion = cFFAc_Buscar
    Else
        iFFAccion = cFFAc_Reemplazar
    End If
    Unload Me
End Sub


Private Sub cmdReplaceAll_Click()
    ActualizarCombo
    sFFBuscar = txtFind.Text
    sFFPoner = txtReplace.Text
    If Len(sFFPoner) = 0 Then
        iFFAccion = cFFAc_Buscar
    Else
        iFFAccion = cFFAc_ReemplazarTodo
    End If
    Unload Me
End Sub


Private Sub Combo1_Change(Index As Integer)
    
    If bBuscandoEnCombo Then Exit Sub
    
    If Index = 0 Then
        txtFind = Combo1(0).Text
    Else
        txtReplace = Combo1(1).Text
    End If
End Sub


Private Sub Combo1_Click(Index As Integer)
    
    If bBuscandoEnCombo Then Exit Sub
    
    If Combo1(Index).ListIndex Then
        Combo1(Index).Text = Combo1(Index).List(Combo1(Index).ListIndex)
    End If
    If Index = 0 Then
        txtFind = Combo1(Index).Text
    Else
        txtReplace = Combo1(Index).Text
    End If
End Sub


Private Sub Form_Load()
    
    If sFFIni = "" Then
        sFFIni = "BuscReemp.ini"
    End If
    'Posicionar en el centro de la ventana principal
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
    
    'En un sub, para que acepte el tag de los combos.
    'Si se dejaba en el Form_Load, no se actualizaban los valores de inicio
    Timer1.Interval = 100
    Timer1.Enabled = True
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    'Si se cierra por el controlbox, o cualquier forma distinta del propio código,
    'asumir que se ha cancelado.
    If UnloadMode <> vbFormCode Then
        iFFAccion = cFFAc_Cancelar
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim N As Integer
    Dim vTmp As String
    Dim sTmp As String
    Dim i As Integer
    Dim j As Integer
    Dim sTag As String
    
    iFFCompleta = chkCompleta.Value
    iFFAtras = chkDireccion.Value
    
    If iFFAccion <> cFFAc_Cancelar Then
        ActualizarCombo
        For i = 0 To 1
            N = Combo1(i).ListCount
            sTag = Trim$(Combo1(i).Tag)
            If N > NumeroMaximoDeItems Then N = NumeroMaximoDeItems
            GuardarIni sFFIni, sTag, "NumEntradas", CStr(N)
            For j = 0 To N - 1
                vTmp = "Entrada" & CStr(j)
                sTmp = Combo1(i).List(j)
                GuardarIni sFFIni, sTag, vTmp, sTmp
            Next
        Next
    End If
    Set gsDBR = Nothing
End Sub


Private Sub ActualizarCombo()
    '-----------------------------------------------------
    'Esta rutina actualiza el contenido de los dos combos,
    'si la entrada en el Combo.Text no está, la incluye.
    'Se podría usar la llamada al API de Windows.
    '-----------------------------------------------------
    'Actualizar el contenido del Combo
    Dim sTmp As String
    'Para más rapidez...
    'Static i As Integer
    'Static j As Integer
    'Static hallado As Boolean
    Static k As Integer
    '
    bBuscandoEnCombo = True
    For k = 0 To 1
        'hallado = False
        sTmp = Combo1(k).Text
        If Len(Trim$(sTmp)) Then
            'j = Combo1(k).ListCount - 1
            'For i = 0 To j
            '    If StrComp(Trim$(sTmp), Trim$(Combo1(k).List(i))) = 0 Then
            '        hallado = True
            '        Exit For
            '    End If
            'Next
            'El valor devuelto no nos interesa
            If ActualizarLista(sTmp, Combo1(k)) Then
            End If
            'If Not hallado Then
            '    Combo1(k).AddItem sTmp, 0
            'End If
        End If
    Next
    bBuscandoEnCombo = False
End Sub


Private Sub IniciarCombo()
    Dim j As Integer
    Dim i As Integer
    Dim N As Integer
    Dim vTmp As String
    Dim sTmp As String
    Dim sTag As String
    
    'asignar los valores anteriores del combo
    For i = 0 To 1
        sTag = Trim$(Combo1(i).Tag)
        N = 0
        N = LeerIni(sFFIni, sTag, "NumEntradas", N)
        If N > NumeroMaximoDeItems Then N = NumeroMaximoDeItems
        '
        For j = 0 To N - 1
            vTmp = "Entrada" & CStr(j)
            sTmp = LeerIni(sFFIni, sTag, vTmp, "")
            If Len(sTmp) Then
                Combo1(i).AddItem sTmp
            End If
        Next
    Next
End Sub


Private Sub Timer1_Timer()
    'asignar los valores anteriores del combo
    Timer1.Enabled = False  'Ya no necesitaremos más este evento!!!
    IniciarCombo
End Sub


Public Sub PosicionarControles()
    
    '==============================================================
    '--------------------------------------------------------------
    'Si se quiere ajustar el tamaño y posición del form ( 6/Sep/97)
    'comentar el Exit Sub
    '--------------------------------------------------------------
    Exit Sub
    '==============================================================
    
    'Posiciona los controles según su estado de visibilidad
    Dim tTop As Integer
    
    'Si se muestra Reemplazar
    tTop = Combo1(0).Top
    With Combo1(1)
        If .Enabled Then
            tTop = .Top
        End If
    End With
    'Se usa enabled en lugar de visible porque los controles
    'no son visibles hasta que se hace el Show del Form
    If chkCompleta.Enabled Then
        chkCompleta.Top = tTop + 510
        tTop = chkCompleta.Top - 150
    End If
    If chkDireccion.Enabled Then
        chkDireccion.Top = tTop + 510
        tTop = chkDireccion.Top
    End If
    cmdFindNext.Top = tTop + 480
    tTop = cmdFindNext.Top
    cmdReplace.Top = tTop
    cmdReplaceAll.Top = tTop
    cmdCancel.Top = tTop
    'Altura del Form
    Height = tTop + 810
End Sub

'---------------------------------------------------------------
'gsDBR.bas Módulo para el diálogo de Buscar y Reemplazar
'
'(c)Guillermo Som, 1997
'---------------------------------------------------------------
Option Explicit

'Nuevas variables para palabra completa y dirección:    ( 6/Sep/97)
Global iFFCompleta As Boolean
Global iFFAtras As Boolean
Global Const cFFAc_Accion = 15      'para los valores normales
Global Const cFFAc_Completa = 32    'si se muestra palabra completa
Global Const cFFAc_Atras = 64       'si se muestra la dirección de búsqueda
'
'Para usar procedimientos genéricos de búsqueda         (31/Ago/97)
Global LineaEstado As Control
'Constantes para el menú de Edición
Global Const mEdDeshacer = 0
Global Const mEdCortar = 1
Global Const mEdCopiar = 2
Global Const mEdPegar = 3
'Const mEdSep1 = 4
Global Const mEdBuscarActual = 5
Global Const mEdBuscarSigActual = 6
Global Const mEdReemplazarActual = 7
'Const mEdSep2 = 8
Global Const mEdSeleccionarTodo = 9
'
'Constantes para las opciones de búsqueda en el TextBox actual
Global Const CMD_BuscarActual = 101
Global Const CMD_BuscarSigActual = 102
Global Const CMD_ReemplazarActual = 103
Global Const CMD_SeleccionarTodo = 104

'Variables y constantes para buscar/reemplazar
Global sFFBuscar As String
Global sFFPoner As String
Global iFFAccion As Integer
'
'Constantes para la acción a realizar
Global Const cFFAc_Cancelar = True
Global Const cFFAc_IDLE = 0
Global Const cFFAc_Buscar = 1
Global Const cFFAc_BuscarSiguiente = 2
Global Const cFFAc_Reemplazar = 3
Global Const cFFAc_ReemplazarTodo = 4
Global Const cFFAc_Aceptar = 5
'
Global sFFIni As String                     'Archivo de configuración

'Funciones Globales del API
#If Win32 Then
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
         
    Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
            (ByVal hWnd As Long, ByVal wMsg As Long, _
             ByVal wParam As Long, ByVal lParam As Long) As Long
#Else
    Declare Function SendMessage Lib "User" _
        (ByVal hWnd As Integer, ByVal wMsg As Integer, _
         ByVal wParam As Integer, lParam As Any) As Long
    Declare Function PostMessage Lib "User" _
            (ByVal hWnd As Integer, ByVal wMsg As Integer, _
             ByVal wParam As Integer, lParam As Any) As Integer
#End If

'Declaración de las constantes, para usar con SendMessage/PostMessage
Global Const WM_CUT = &H300
Global Const WM_COPY = &H301
Global Const WM_PASTE = &H302
'Global Const WM_CLEAR = &H303
'
Global Const EM_CANUNDO = &HC6
Global Const EM_UNDO = &HC7


Public Function ActualizarLista(ByVal sTexto As String, cList As Control, Optional vTipoBusqueda, Optional vAddLista) As Long
    'Esta función comprobará si el texto indicado existe en la lista
    'Si no es así, lo añadirá
    'El valor devuelto, será la posición dentro de la lista ó -1 si hay "fallos"
    '
    'Para buscar en el List/combo usaremos una llamada al API
    '(si ya hay una forma de hacerlo, ¿para que re-hacerla?)
    '
    'Constantes para los combos
    Const CB_FINDSTRINGEXACT = &H158
    Const CB_FINDSTRING = &H14C
    Const CB_SELECTSTRING = &H14D
    'Constantes para las Listas
    Const LB_FINDSTRINGEXACT = &H1A2        'Busca la cadena exactamente igual
    Const LB_FINDSTRING = &H18F             'Busca en cualquier parte de la cadena
    Const LB_SELECTSTRING = &H18C           'Busca desde el principio de la cadena
    '
    Dim lTipoBusqueda As Long
    Dim bTipoBusqueda As Integer            '0= Exacta, 1= cualquier parte, 2=desde el principio
    Dim bAddLista As Boolean
    Dim L As Long
    
    'Si se busca palabra completa o parcial,
    'por defecto COMPLETA
    If IsMissing(vTipoBusqueda) Then
        bTipoBusqueda = False
    Else
        bTipoBusqueda = vTipoBusqueda
    End If
    'Si se debe añadir o no, por defecto SI
    If IsMissing(vAddLista) Then
        bAddLista = True
    Else
        bAddLista = vAddLista
    End If
    
    'Si el control es un Combo
    If TypeOf cList Is ComboBox Then
        If bTipoBusqueda = 1 Then
            lTipoBusqueda = CB_FINDSTRING
        ElseIf bTipoBusqueda = 2 Then
            lTipoBusqueda = CB_SELECTSTRING
        Else
            lTipoBusqueda = CB_FINDSTRINGEXACT
        End If
    'Si el control es un list
    ElseIf TypeOf cList Is ListBox Then
        If bTipoBusqueda = 1 Then
            lTipoBusqueda = LB_FINDSTRING
        ElseIf bTipoBusqueda = 2 Then
            lTipoBusqueda = LB_SELECTSTRING
        Else
            lTipoBusqueda = LB_FINDSTRINGEXACT
        End If
    Else
        'no es un control List o Combo, salir
        ActualizarLista = -1
        Exit Function
    End If
    
    If cList.ListCount = 0 Then
        'Seguro que no está, así que añadirla, si viene al caso...
        L = -1
    Else
        L = SendMessage(cList.hWnd, lTipoBusqueda, -1, ByVal sTexto)
    End If
    
    'Si no está, añadirla
    If L = -1 Then
        If bAddLista Then
            'Con el 0 se añade al principio de la lista
            cList.AddItem sTexto, 0
            L = ActualizarLista(sTexto, cList, bTipoBusqueda, bAddLista)
        End If
    End If
    ActualizarLista = L
End Function


Public Function gsReemplazar(sBuscar As String, sPoner As String, Optional vModo, Optional vCaption) As Integer
    'Prepara el diálogo de Reemplazar
    Dim iModo As Integer
    Dim sCaption As String
    
    If IsMissing(vModo) Then
        iModo = cFFAc_Reemplazar
    Else
        iModo = vModo
    End If
    
    If IsMissing(vCaption) Then
        sCaption = "Reemplazar"
    Else
        sCaption = CStr(vCaption)
    End If
    
    iFFAccion = cFFAc_IDLE
    With gsDBR
        'Por ahora no se muestra en reemplazar          ( 6/Sep/97)
        .chkCompleta.Visible = False
        .chkCompleta.Enabled = False
        .chkDireccion.Visible = False
        .chkDireccion.Enabled = False
        .Caption = sCaption
        .cmdFindNext.Default = False
        .cmdFindNext.Visible = False
        .cmdReplaceAll.Default = True
        .Combo1(0).Text = sBuscar
        .Combo1(1).Text = sPoner
        .PosicionarControles
        'Mostrar el form y esperar a que se tome una acción
        .Show vbModal
        'Do
        '    .Show
        '    DoEvents
        'Loop Until iFFAccion
    End With
    'Devolver la cadena a reemplazar y buscar
    sBuscar = sFFBuscar
    sPoner = sFFPoner
    'Si tanto buscar como poner están en blanco, devolver cancelar
    If Len(Trim$(sBuscar)) = 0 Then
        If Len(Trim$(sPoner)) = 0 Then
            iFFAccion = cFFAc_Cancelar
        End If
    End If
    'Devolver la acción
    gsReemplazar = iFFAccion
End Function


Public Function gsBuscar(sBuscar As String, Optional vModo, Optional vCaption) As Integer
    'Prepara el diálogo para buscar
    Dim iModo As Integer
    Dim sCaption As String
    Dim bCompleta As Boolean
    Dim bAtras As Boolean
        
    If IsMissing(vModo) Then
        iModo = cFFAc_Buscar
        bCompleta = False
        bAtras = False
    Else
        bCompleta = vModo And cFFAc_Completa
        bAtras = vModo And cFFAc_Atras
        'quedarse sólo con los valores normales
        iModo = vModo And cFFAc_Accion
    End If
    'Sólo permitir buscar y buscar-siguiente
    Select Case iModo
    Case cFFAc_Buscar, cFFAc_BuscarSiguiente
        'está bien, no hay nada que hacer
    Case Else
        iModo = cFFAc_Buscar
    End Select
    
    If IsMissing(vCaption) Then
        sCaption = "Buscar"
    Else
        sCaption = CStr(vCaption)
    End If
    
    iFFAccion = cFFAc_IDLE
    With gsDBR
        'Si se muestra la opción de palabra completa
        .chkCompleta.Visible = bCompleta
        .chkCompleta.Enabled = bCompleta
        .chkCompleta = Abs(CInt(iFFCompleta))
        'si se muestra la opción de dirección de búsqueda
        .chkDireccion.Visible = bAtras
        .chkDireccion.Enabled = bAtras
        .chkDireccion = Abs(CInt(iFFAtras))
        
        .Caption = sCaption
        .cmdReplace.Visible = False
        .lblReplace.Visible = False
        .cmdReplaceAll.Visible = False
        .Combo1(1).Visible = False
        .Combo1(1).Enabled = False
        .cmdFindNext.Left = .cmdReplaceAll.Left
        If iModo = cFFAc_BuscarSiguiente Then
            .cmdFindNext.Caption = "Siguiente"
            DoEvents
        End If
        .Combo1(0).Text = sBuscar
        .PosicionarControles
        'Mostrar el form y esperar a que se tome una acción
        .Show vbModal
        'Do
        '    .Show
        '    DoEvents
        'Loop Until iFFAccion
    End With
    'Devolver la cadena seleccionada/introducida
    sBuscar = sFFBuscar
    'Devolver la acción
    gsBuscar = iFFAccion
End Function


Public Sub gsPedirUnValor(spuvTitulo As String, spuvMensaje As String, spuvPregunta As String, spuvValor As String, spuvBoton As String)
    
    'Rutina de propósito general para pedir un valor (00.22 23/May/96)
    With gsDBR
        .chkCompleta.Visible = False
        .chkCompleta.Enabled = False
        .chkDireccion.Visible = False
        .chkDireccion.Enabled = False
        .Caption = spuvTitulo
        .Combo1(0).Visible = False
        .lblBuscar.Width = .ScaleWidth - 120
        .lblBuscar = spuvMensaje
        .Combo1(0).Visible = False
        .cmdReplace.Visible = False
        .cmdFindNext.Default = False
        .cmdFindNext.Visible = False
        .lblReplace = spuvPregunta
        .cmdReplaceAll.Default = True
        .cmdReplaceAll.Caption = spuvBoton
        If Len(Trim$(spuvValor)) Then
            .Combo1(1).Text = spuvValor
        Else
            If .Combo1(1).ListCount Then
                .Combo1(1).ListIndex = 0
            End If
        End If
        .PosicionarControles
        .Show vbModal
    End With
    spuvValor = sFFPoner
End Sub


Private Sub AccionBuscar(Index As Integer)
    '--------------------------------------------------------------
    'Procedimiento genérico para realizar búsquedas     (31/Ago/97)
    '
    'Valores necesarios:
    '   LineaEstado     un control para mostrar mensajes temporales
    '   CMD_xxx         Apuntará a los índices del menú de edición
    '                   que deberá tener estas opciones:
    '           Deshacer
    '           Cortar
    '           Copiar
    '           Pegar
    '           ---
    '           Buscar
    '           Buscar Siguiente
    '           Reemplazar
    '           ---
    '           Seleccionar Todo
    '
    '--------------------------------------------------------------
    Static sBuscar As String
    Static lngUltimaPos As Long
    Dim lngPosActual As Long
    Dim sTmp As String
    Dim tText As Control
        
    Set tText = Screen.ActiveForm.ActiveControl
    'Si no es un cuadro de texto, salir
    If Not (TypeOf tText Is TextBox) Then
        Exit Sub
    End If
    
    LineaEstado.Tag = LineaEstado
    
    'para procesar las otras acciones adicionales   (15/Abr/97)
    Select Case Index
    Case CMD_BuscarActual
        'Si hay texto seleccionado...
        With tText
            If .SelLength > 0 Then
                sBuscar = Trim$(.SelText)
            End If
        End With
        'Para "personalizar" la sección de búsqueda...
        gsDBR.Combo1(0).Tag = "Buscar_" & sUsuario
        If gsBuscar(sBuscar, , "Buscar en el campo actual") > cFFAc_IDLE Then
            sBuscar = Trim$(sBuscar)
            If Len(sBuscar) Then
                LineaEstado = "Buscando en el campo actual " & sBuscar & "..."
                DoEvents
                lngUltimaPos = 0&
                lngPosActual = InStr(tText, sBuscar)
                If lngPosActual Then
                    lngUltimaPos = lngPosActual + 1
                    'posicionarse en esa palabra:
                    With tText
                        .SelStart = lngPosActual - 1
                        .SelLength = Len(sBuscar)
                    End With
                Else
                    Beep
                    MsgBox "No se ha hallado el texto buscado", vbOK + vbInformation, "Buscar en el campo actual"
                End If
                'posicionarse en ese control
                tText.SetFocus
            End If
        End If
    Case CMD_BuscarSigActual
        'Si no hay nada hallado con anterioridad
        'o no se ha procesado la última búsqueda en este control
        If Len(sBuscar) = 0 Or lngUltimaPos = 0& Then
            AccionBuscar CMD_BuscarActual
        Else
            LineaEstado = "Buscando " & sBuscar & "..."
            DoEvents
            lngPosActual = InStr(lngUltimaPos, tText, sBuscar)
            If lngPosActual Then
                lngUltimaPos = lngPosActual + Len(sBuscar)
                'posicionarse en esa palabra:
                With tText
                    .SelStart = lngPosActual - 1
                    .SelLength = Len(sBuscar)
                End With
            Else
                lngUltimaPos = 1&
                Beep
                MsgBox "No se ha hallado el texto buscado.", vbOK + vbInformation, "Buscar en el campo actual"
            End If
            'posicionarse en ese control
            tText.SetFocus
        End If
    Case CMD_ReemplazarActual
        'Si hay texto seleccionado...
        With tText
            If .SelLength > 0 Then
                sBuscar = Trim$(.SelText)
            End If
        End With
        
        sFFBuscar = sBuscar
        sFFPoner = ""
        'Personalizar las secciones de buscar/reemplazar
        gsDBR.Combo1(0).Tag = "Buscar_" & sUsuario
        gsDBR.Combo1(1).Tag = "Reemplazar_" & sUsuario
        iFFAccion = gsReemplazar(sFFBuscar, sFFPoner, , "Reemplazar en el campo actual")
        If iFFAccion <> cFFAc_Cancelar Then
            elForm.MousePointer = vbHourglass
            DoEvents
            sBuscar = Trim$(sFFBuscar)
            If Len(sFFBuscar) <> 0 And Len(sFFPoner) <> 0 Then
                If iFFAccion = cFFAc_Reemplazar Or iFFAccion = cFFAc_ReemplazarTodo Then
                    LineaEstado = "Reemplazando " & sBuscar & "..."
                    DoEvents
                    lngUltimaPos = 0&
                    lngPosActual = InStr(tText, sBuscar)
                    If lngPosActual Then
                        lngUltimaPos = lngPosActual + Len(sBuscar)
                        sTmp = tText 'Text1(ControlActual).Text
                        sTmp = Left$(sTmp, lngPosActual - 1) & sFFPoner & Mid$(sTmp, lngPosActual + Len(sFFBuscar))
                        tText = sTmp
                        'Si sólo es reemplazar uno...
                        If iFFAccion = cFFAc_Reemplazar Then Exit Sub
                        'Cambiar todas las coincidencias en el mísmo text
                        lngUltimaPos = 1
                        Do
                            lngPosActual = InStr(lngUltimaPos, sTmp, sFFBuscar)
                            If lngPosActual Then
                                lngUltimaPos = lngPosActual + 1
                                sTmp = Left$(sTmp, lngPosActual - 1) & sFFPoner & Mid$(sTmp, lngPosActual + Len(sFFBuscar))
                                tText = sTmp
                            End If
                        Loop While lngPosActual
                        DoEvents
                    Else
                        Beep
                        MsgBox "No se ha hallado el texto buscado.", vbOK + vbInformation, "Buscar en el campo actual"
                    End If
                    'Si se ha reemplazado to, no debe estar esta palabra...
                    lngUltimaPos = 0&
                End If
            End If
            elForm.MousePointer = vbDefault
            DoEvents
        End If
    Case CMD_SeleccionarTodo
        With tText
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    End Select
    LineaEstado = LineaEstado.Tag
End Sub


Public Sub menuEdi()
    'Habilitar las opciones disponibles
    Dim Habilitada As Boolean
    Dim i As Integer
    
    'los separadores no se pueden deshabilitar!!!
    On Local Error Resume Next
    
    'Asegurarnos que es un textbox
    If TypeOf Screen.ActiveForm.ActiveControl Is TextBox Then
        'ok, todo bien...
        Habilitada = True
    Else
        'no poder hacer estas cosas
        Habilitada = False
    End If
    For i = mEdDeshacer To mEdSeleccionarTodo
        elForm!mnuEdicion(i).Enabled = Habilitada
    Next
    'Algunos chequeos para las opciones de edición:
    If Habilitada Then
        'Si no se puede deshacer, no habilitarlo
        If SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_CANUNDO, 0, ByVal 0&) Then
            elForm!mnuEdicion(mEdDeshacer).Enabled = True
        Else
            elForm!mnuEdicion(mEdDeshacer).Enabled = False
        End If
        'comprobar si hay algo que pegar...
        If Clipboard.GetFormat(vbCFText) Then
            elForm!mnuEdicion(mEdPegar).Enabled = True
        Else
            elForm!mnuEdicion(mEdPegar).Enabled = False
        End If
    End If
    Err = 0
    On Local Error GoTo 0
End Sub


Public Sub menuEdicion(Index As Integer)
    Select Case Index
    Case mEdDeshacer
        '-------------------------------------------------------------
        ' IMPORTANTE:
        ' En ambos casos se podría usar SendMessage,
        ' pero en el caso de EM_CANUNDO, NO serviría PostMessage,
        ' porque esta función sólo devuelve un valor de
        ' si se ha puesto o no en la cola de mensajes de windows.
        '-------------------------------------------------------------
        'Si se puede deshacer...
        If SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_CANUNDO, 0, ByVal 0&) Then
            'Deshacerlo!
            If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_UNDO, 0, ByVal 0&) Then
            End If
        End If
    Case mEdCopiar
        If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_COPY, 0, ByVal 0&) Then
        End If
    Case mEdCortar
        If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_CUT, 0, ByVal 0&) Then
        End If
    Case mEdPegar
        If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_PASTE, 0, ByVal 0&) Then
        End If
    Case mEdBuscarActual
        AccionBuscar CMD_BuscarActual
    Case mEdBuscarSigActual
        AccionBuscar CMD_BuscarSigActual
    Case mEdReemplazarActual
        AccionBuscar CMD_ReemplazarActual
    Case mEdSeleccionarTodo
        AccionBuscar CMD_SeleccionarTodo
    End Select
End Sub

Bájate estos listados (para VB5) con un ejemplo de cómo usarlo (t_imprimir.zip 17.4 KB)
Bájate los listados y el ejemplo para VB4 (t_imprimirVB4.zip 16.5 KB)