Autor
|
Tema: Extraer texto de la etiqueta <font></font> [SRC] (Leído 4,075 veces)
|
<[(x)]>
Desconectado
Mensajes: 215
|
holas aka les dejo este pequeño code. que lo empece haciendo para una pagina en otro idioma y se me ocurrió traducirlo. Lo que hace es extraer el texto que se encuentre entre '<font>' y '</font>. En un modulo: Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String) Dim strText() As String: ReDim strText(0) As String Dim strBuf As String Dim bol As Boolean: bol = False strBuf = strData Do While Not bol If InStr(LCase(strBuf), "<font") > 0 Then strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font")) If InStr(LCase(strBuf), ">") > 0 Then Dim inta As Integer: inta = InStr(LCase(strBuf), ">") If InStr(LCase(strBuf), "</font") > 0 Then Dim intb As Integer intb = InStr(LCase(strBuf), "</font") - inta PlusArray strText, Mid(strBuf, inta + 1, intb - 1) strBuf = Mid(strBuf, inta) Else bol = True End If Else bol = True End If Else bol = True End If Loop ReDim strArrayOut(UBound(strText)) As String strArrayOut = strText End Sub Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String) Dim lngP As Long lngP = UBound(strArray) + 1 ReDim Preserve strArray(lngP) strArray(lngP) = strPlus End Sub
Y para probarlo en un form: Private Sub Form_Load() Dim x As Integer Dim strText As String Dim strArrayText() As String strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font> <font > un pedo </font>" ExtractText strText, strArrayText Me.Print "Prueba:" Me.Print "" Me.Print "" For x = 0 To UBound(strArrayText) Me.Print " " & strarraytext(x) Next End Sub
Bue no se, se puede usar si quieres hacer una búsqueda en una web. 54¬U|)()5
|
|
« Última modificación: 2 Febrero 2009, 02:48 am por <[(x)]> »
|
En línea
|
<[(x)]>
|
|
|
seba123neo
|
Hola, funciona bien, pero corregile la linea Me.Print " " & strArrayText(x)
te falto una "r".... y usa la etiqueta de codigo de visual , asi queda mas lindo el codigo..creo que la funcion podria tener menos codigo, si puedo ahora lo veo... saludos.
|
|
|
En línea
|
|
|
|
<[(x)]>
Desconectado
Mensajes: 215
|
holas
Gracias por la corrección.
y cual es la etiqueta que me decís?
------------------------------------
oks gracias
|
|
« Última modificación: 2 Febrero 2009, 02:47 am por <[(x)]> »
|
En línea
|
<[(x)]>
|
|
|
seba123neo
|
cuando creas un post tenes al lado un combo que dice "Geshi" ahi elegis el lenguaje para el codigo...
|
|
|
En línea
|
|
|
|
el_c0c0
Desconectado
Mensajes: 307
|
holas aka les dejo este pequeño code. que lo empece haciendo para una pagina en otro idioma y se me ocurrió traducirlo. Lo que hace es extraer el texto que se encuentre entre '<font>' y '</font>. En un modulo: Public Sub ExtractText(ByVal strData As String, ByRef strArrayOut() As String) Dim strText() As String: ReDim strText(0) As String Dim strBuf As String Dim bol As Boolean: bol = False strBuf = strData Do While Not bol If InStr(LCase(strBuf), "<font") > 0 Then strBuf = Mid(strBuf, InStr(LCase(strBuf), "<font")) If InStr(LCase(strBuf), ">") > 0 Then Dim inta As Integer: inta = InStr(LCase(strBuf), ">") If InStr(LCase(strBuf), "</font") > 0 Then Dim intb As Integer intb = InStr(LCase(strBuf), "</font") - inta PlusArray strText, Mid(strBuf, inta + 1, intb - 1) strBuf = Mid(strBuf, inta) Else bol = True End If Else bol = True End If Else bol = True End If Loop ReDim strArrayOut(UBound(strText)) As String strArrayOut = strText End Sub Public Sub PlusArray(ByRef strArray() As String, ByVal strPlus As String) Dim lngP As Long lngP = UBound(strArray) + 1 ReDim Preserve strArray(lngP) strArray(lngP) = strPlus End Sub
Y para probarlo en un form: Private Sub Form_Load() Dim x As Integer Dim strText As String Dim strArrayText() As String strText = "<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font> <font > un pedo </font>" ExtractText strText, strArrayText Me.Print "Prueba:" Me.Print "" Me.Print "" For x = 0 To UBound(strArrayText) Me.Print " " & strarraytext(x) Next End Sub
Bue no se, se puede usar si quieres hacer una búsqueda en una web. 54¬U|)()5 estas haciendo cagadas, mira cuantas lineas al dope. asi vas a hacer errores (creeria que no) y/o tardar mucho usa la funcion TEXTINBETWINE (de cobein, pero le pegue una modificacion yo) Public Function TextInBetwinE(ByVal sData As String, ByVal sStart As String, ByVal sEnd As String) As String If InStr(sData, sStart) > 0 Then sData = Mid(sData, InStr(sData, sStart) + Len(sStart)) TextInBetwinE = Mid(sData, 1, InStr(sData, sEnd) - 1) End If End Function
tene cuidado, si no existe el tag de cerrado, va a tirar error la funcion trabaja asi: encuentra la primer coincidencia, y hace que llegue hasta la primer coincidencia final llama a la funcion asi TextInBetwinE("<font > el electrodo magico </font><font > mucha variedad en electrodos </font> <font > electrodo automatico </font> <font > un pedo </font>", "<font >", "</font>")
eso te devuelve el primer tag.. para sacar el segundo tag, hace un replace a la cadena original, sacando el tag actual y hace asi hasta q no haya mas tags saludos
|
|
« Última modificación: 2 Febrero 2009, 03:34 am por el_c0c0 »
|
En línea
|
'- coco "Te voy a romper el orto"- Las hemorroides
|
|
|
<[(x)]>
Desconectado
Mensajes: 215
|
Bien coco.
Pensaste que la etiqueta podría ser <font color="#DD6600">blablabla</font>.
me parece que tu método no funcionaria ahi.
|
|
|
En línea
|
<[(x)]>
|
|
|
el_c0c0
Desconectado
Mensajes: 307
|
Bien coco.
Pensaste que la etiqueta podría ser <font color="#DD6600">blablabla</font>.
me parece que tu método no funcionaria ahi.
para eso necesitas un parser, a lo xml o algo asi! para hacer que funcione con ese ejemplo, modifica y pone asi: TextInBetwinE(".... ", "<font ", "</font>")
y te quedaria color="#DD6600">blablabla saludos
|
|
|
En línea
|
'- coco "Te voy a romper el orto"- Las hemorroides
|
|
|
<[(x)]>
Desconectado
Mensajes: 215
|
jej..holas
Explicitame lo de ''un parser, a lo xml o algo asi!'' y si no se optiene el mismo resultado,.. no me cirbe.
|
|
|
En línea
|
<[(x)]>
|
|
|
|
el_c0c0
Desconectado
Mensajes: 307
|
jej..holas
Explicitame lo de ''un parser, a lo xml o algo asi!'' y si no se optiene el mismo resultado,.. no me cirbe.
yo te digo, usa el parser.. usa el que te paso xkiz. parser es una herramienta que entiende un texto o lo que sea, segun lo que uno quiera sacar... en este caso un parser xml. xml porque es mas o mismo que html, pero bueno. si vos queres q te devuelva lo mismo, imaginatelas. No es dificil!!!!! Dim strRet As String strRet = TextInBetwinE("<font color=""#DD6600"">blablabla</font>", "<font ", "</font>") If Left(strRet, 1) = ">" Then strRet = Right(strRet, Len(strRet) -1) Else strRet = Right(strRet, Len(strRet) - InStr(strRet, ">")) End If
asi lo sacas. pero la proxima fijate vos eso.. que no es nada dificil saludos
|
|
|
En línea
|
'- coco "Te voy a romper el orto"- Las hemorroides
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
La font de msdos?
Diseño Gráfico
|
BenRu
|
4
|
2,757
|
17 Agosto 2005, 21:27 pm
por BenRu
|
|
|
Web Open Font Format (WOFF) convertido en estándar
Noticias
|
wolfbcn
|
0
|
1,420
|
15 Diciembre 2012, 01:52 am
por wolfbcn
|
|
|
No funciona fuente @font-face [CSS]
Desarrollo Web
|
UsuarioZ
|
2
|
2,709
|
13 Abril 2020, 13:20 pm
por UsuarioZ
|
|
|
ajustar texto a pantalla completa. font-size 100%
Desarrollo Web
|
OssoH
|
0
|
2,829
|
6 Noviembre 2020, 16:53 pm
por OssoH
|
|
|
Font zapfino
Desarrollo Web
|
huerto123
|
1
|
2,608
|
10 Enero 2021, 14:44 pm
por Drakaris
|
|