[SRC] + [Función] Text_Between_Words [by *PsYkE1*]

[Psyke1]

ATENCION: SRC CORREGIDO

Hola, aqui os dejo esta funcin que acabo de hacer, no es gran cosa, pero bueno...  

Código (vb) [Seleccionar] Expandir


' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Agradecimientos a BlackZeroX & Cobein                     //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
Option Explicit
Public Function Text_Between_Words(ByVal sTextToAnalyze As String, ByVal sStartWord As String, ByVal sEndWord As String) As String
    Dim iPosition1             As Integer
    Dim iPosition2             As Integer
    Dim iStart                 As Integer
   
    iPosition1 = InStr(sTextToAnalyze, sStartWord)
    If iPosition1 <> 0 Then
        iStart = iPosition1 + Len(sStartWord)
        iPosition2 = InStr(iStart, sTextToAnalyze, sEndWord)
    Else
        Exit Function
    End If
    If iPosition2 <> 0 Then
        Text_Between_Words = Mid$(sTextToAnalyze, iStart, iPosition2 - iStart)
    End If
End Function
Un ejemplo seria asi:

Código [Seleccionar] Expandir


El contexto es el ámbito de referencia de un texto. ¿Qué entiendo por ámbito de referencia?.

Código (vb) [Seleccionar] Expandir


   Debug.Print Text_Between_Words(Text1.Text, "referencia", "entiendo")

El resultado seria:

de un texto. ¿Qué

Y si pongo esto:

Código (vb) [Seleccionar] Expandir


   Debug.Print Text_Between_Words(Text1.Text, "referencia", "referencia")

Me sale esto:

de un texto. ¿Qué entiendo por ámbito de

Espero que os haya gustado(mas aun  )...

Salu2!

[ssccaann43 ©]

Muy bueno *PsYkE1*, me gustó...!

[Elemental Code]

me costo entender como andaba asi que voy a explicarlo otra vez. 

Si en la caja de texto escribo

Código [Seleccionar] Expandir

No entendi el codigo y por eso hago esto

y llamo a la funcion como

Código (vb) [Seleccionar] Expandir

MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")

me responde:

Código [Seleccionar] Expandir

y por eso hago

Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S...

Ademas. Para que sirve??

Muy bueno para aprender como usar el instr que no sabia que existia y para practicar pero no entendi del todo para que sirve 

Toda la onda

[ssccaann43 ©]

  Me intrigo eso de que el mensaje esta en ingles...!

*PsYkE1*, no lo tomes a mal, pero detesto a los Copy&Paste...! Espero que esa funcion sea 100% tuya... Sino, tomate este momento para colocar su autor...! 

[ssccaann43 ©]

me costo entender como andaba asi que voy a explicarlo otra vez. 

Si en la caja de texto escribo

Código [Seleccionar] Expandir

No entendi el codigo y por eso hago esto

y llamo a la funcion como

Código (vb) [Seleccionar] Expandir

MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")

me responde:

Código [Seleccionar] Expandir

y por eso hago

Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S...

Ademas. Para que sirve??

Muy bueno para aprender como usar el instr que no sabia que existia y para practicar pero no entendi del todo para que sirve 

Toda la onda

Por cierto asi es como funciona Elemental, te muestra el texto que contiene una frase entre 2 palabras...!

[Psyke1]

Muy bueno *PsYkE1*, me gustó...!

Gracias ssccaann43!

me costo entender como andaba asi que voy a explicarlo otra vez.  

Si en la caja de texto escribo

Código [Seleccionar] Expandir

No entendi el codigo y por eso hago esto

y llamo a la funcion como

Código (vb) [Seleccionar] Expandir

MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")

me responde:

Código [Seleccionar] Expandir

y por eso hago

Si, exacto, pero no te olvides de si la palabra lleva minusculas o MAYUSCULAS...

Código (vb) [Seleccionar] Expandir

MsgBox Text_Between_Words(Text1.Text, "codigo", "esto")

Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S...

Jajaja
Pense que quedaria más internacional...

Ademas. Para que sirve??

He posteado porque lo necesitaba para un proyecto que estoy haciendo, y pense que podia ser interesante...

Salu2!

[Psyke1]

Me intrigo eso de que el mensaje esta en ingles...!

*PsYkE1*, no lo tomes a mal, pero detesto a los Copy&Paste...! Espero que esa funcion sea 100% tuya... Sino, tomate este momento para colocar su autor...! 

Te puedo asegurar que no es C&P ssccaann43...
El mensaje lo puse en ingles con el Google traductor...
Me desagrada que pienses eso...
Prefiero subir una m**** de code (como ya he hecho en ocasiones) a hacer un C&P...

Salu2!

[ssccaann43 ©]

Bueno, te pedi que no te molestaras ni lo tomes a mal...!

Excelente entonces...! Un saludo...!

[BlackZeroX]

.
Dejen de decir C&P y opinen ("Eso diria si fuese el autor del hilo...")

Código (vb) [Seleccionar] Expandir



Dim pos1 as integer



Es pos1 o pos?

para que no te sucedan estas cosas feas usa al inicio

Código (vb) [Seleccionar] Expandir



option explicit



* Lo peor que puedes hacer en una funcion es meterle un msgbox inputbox o X cosa SON ESTORBOS CREEME NO SON DINAMICOS.

Por otra parte...

Aqui esta mi funcion Entre Texto es "Anti-Error".

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////
Option Explicit
Public Function Entre_Texto(ByRef StrIn As String, ByVal StrIni As String, ByVal StrFin As String, Optional ComparacionEstricta As Boolean) As String
Dim Pos(1) As Long
Dim IniPos As Long
Dim OptionalCompare As VbCompareMethod

    If Len(StrIn) > 0 Then
        If ComparacionEstricta Then
            OptionalCompare = vbBinaryCompare
        Else
            OptionalCompare = vbTextCompare
        End If
        Pos(0) = InStr(1, StrIn, StrIni, OptionalCompare)
        Pos(1) = InStr(1, StrIn, StrFin, OptionalCompare)
        If CBool(Pos(0)) And CBool(Pos(1)) And Pos(0) < Pos(1) Then
            IniPos = Pos(0) + Len(StrIni)
            Entre_Texto = Mid$(StrIn, IniPos, Pos(1) - IniPos)
        End If
    End If
End Function



Aqui dejo tres funciones que hacen esactamente lo mismo (Ojo esta igual viene incluida pero corregida por un servidor, incluyo la que yo cree y use desde hace mucho).

Código (vb) [Seleccionar] Expandir



Option Explicit

Private Function TextoEntreMedio(Texto As String, Palabra1 As String, Palabra2 As String)
    TextoEntreMedio = Left$(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), InStr(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), Palabra2) - 1)
End Function

Public Function Text_Between_Words(Text As String, String1 As String, String2 As String) As String
    Dim Pos1              As Integer
    Dim Pos2              As Integer
    Dim Start             As Integer
    Dim TotalLen          As Integer
    Pos1 = InStr(Text, String1)
    Pos2 = InStr(Text, String2)
    If Pos1 = 0 Or Pos2 = 0 Then GoTo NoExists
    Start = Pos1 + Len(String1)
    TotalLen = Pos2 - Start
    Text_Between_Words = Mid(Text, Start, TotalLen)
    Exit Function
NoExists:
    MsgBox "Error, check that the two words are in the text, if so," & vbCrLf _
    & " make sure you are entered correctly.", vbCritical
End Function

'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////
Public Function Entre_Texto(ByRef StrIn As String, ByVal StrIni As String, ByVal StrFin As String, Optional ComparacionEstricta As Boolean) As String
Dim Pos(1) As Long
Dim IniPos As Long
Dim OptionalCompare As VbCompareMethod

    If Len(StrIn) > 0 Then
        If ComparacionEstricta Then
            OptionalCompare = vbBinaryCompare
        Else
            OptionalCompare = vbTextCompare
        End If
        Pos(0) = InStr(1, StrIn, StrIni, OptionalCompare)
        Pos(1) = InStr(1, StrIn, StrFin, OptionalCompare)
        If CBool(Pos(0)) And CBool(Pos(1)) And Pos(0) < Pos(1) Then
            IniPos = Pos(0) + Len(StrIni)
            Entre_Texto = Mid$(StrIn, IniPos, Pos(1) - IniPos)
        End If
    End If
End Function

Private Sub Form_Load()
Const StrOri As String = "Miguel Angel Ortega Avila"
Const StrIni As String = "an"
Const StrFin As String = "vila"

    MsgBox Text_Between_Words(StrOri, StrIni, StrFin)
    MsgBox TextoEntreMedio(StrOri, StrIni, StrFin)
   
    MsgBox Entre_Texto(StrOri, StrIni, StrFin, True)
    MsgBox Entre_Texto(StrOri, StrIni, StrFin, False)
End Sub



Dulce Infierno Lunar!¡.

[BlackZeroX]

se me olvido el formato REAL de InStr() es

Código [Seleccionar] Expandir



Function InStr([Start], [String1], [String2], [Compare As VbCompareMethod = vbBinaryCompare])
   Miembro de VBA.Strings
   Devuelve la posición de la primera instancia de una cadena dentro de otra

Function InStrB([Start], [String1], [String2], [Compare As VbCompareMethod = vbBinaryCompare])
   Miembro de VBA.Strings
   Devuelve la posición del byte de la primera instancia de una cadena dentro de otra

Function InStrRev(StringCheck As String, StringMatch As String, [Start As Long = -1], [Compare As VbCompareMethod = vbBinaryCompare]) As Long
   Miembro de VBA.Strings
   Returns the position of the last occurrence of one string within another



Para quien no sepa que funciones existen en vb6 abran el IDE creen o abaran un nuevo proyecto y opriman la fecla [/b]F2

Tamabien se pueden acceder desde el Intelicense escribiendo

VBA.

como si fuese

Me.

Text1.

ETC...



Dulce Infierno Lunar!¡.