Visual Basic Foro

¿ Por alguna razon especial no utilizas el vbModal en el Show ?

Si para volver al formulario llamante debe cerrar el llamado es lo mas simple. Así Ocultas y Visualizas el Llamante y en el llamado sólo debes cerrar.

Formulario1
Form1.Hide
Form3.Show vbModal
Form1.Show

Formulario2
Form2.Hide
Form3.Show vbModal
Form2.Show

Formulario3
Unload Me

Saludos

Hola de nuevo:
Se me ha ocurrido utilizar la funcion para leer el TXT desde una URL

Option Explicit

'Tipos de Conexión
Private Const INTERNET_DEFAULT = 0
Private Const INTERNET_DIRECT = 1
Private Const INTERNET_PROXY = 3

Private Const INTERNET_FLAG_RELOAD = &H80000000

'UserAgent del Browser
Public Const scUserAgent = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Trident/4.0; GTB6.5; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729; .NET4.0C; .NET4.0E; msn OptimizedIE8;ESXL)"

'Funcion para Abrir URL
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer

'Cookie
Public Declare Function InternetGetCookie Lib "wininet.dll" Alias "InternetGetCookieA" (ByVal lpszUrlName As String, ByVal lpszCookieName As String, ByVal lpszCookieData As String, lpdwSize As Long) As Boolean

Public Function LeerDeURL(ByVal sURL As String) As String
  On Error Resume Next
  Dim hOpen               As Long
  Dim hOpenUrl            As Long
  Dim bDoLoop             As Boolean
  Dim bRet                As Boolean
  Dim sReadBuffer         As String * 2048
  Dim lNumberOfBytesRead  As Long
  Dim sBuffer             As String
   
  hOpen = InternetOpen(scUserAgent, INTERNET_DEFAULT, vbNullString, vbNullString, 0)
  hOpenUrl = InternetOpenUrl(hOpen, sURL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
   
  bDoLoop = True
  Do While bDoLoop
    sReadBuffer = vbNullString
    bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
    sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
    If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
  Loop
  If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
  If hOpen <> 0 Then InternetCloseHandle (hOpen)
  LeerDeURL = sBuffer
End Function
Y me ha funcionado perfectamente:

Recibido = LeerDeURL("http://www.whatsmyip.us/showipsimple.php")

y me devuelve document.write("nnn.nnn.nnn.nnn");  con lo que ya puedo obtener la IP que está entre comillas.

Saludos

Edito para indicar que con el fin de no depender de terceros, acabo de subir al dominio de la empresa un pequeño archivo PHP con el siguiente contenido:
<? echo $_SERVER['REMOTE_ADDR'] ; ?>
Así al leer este archivo de la misma manera indicada, simplemente me devuelve nnn.nnn.nnn.nnn y ya no tengo que hacer nada mas.

Pues esto, lo dicho en el título, como puedo leer el Texto que me aprece en un WebBrowser el cual me indica unicamente mi IP

<!--Beginning of IP Script-->
<script type="text/javascript" src="http://www.whatsmyip.us/showipsimple.php"> </script>
<!--End of IP Script--> 

He conseguido encontrar este código que pegado en un archivo htm 'navegando hacia el mismo con un simple

WebBrowser1.Navigate App.Path & "\Mi_IP.htm"
Me devuelve la IP, pero quisiera saber como leer el texto devuelto para poder enviarlo directamente hacia un determinado archivo txt en dropbox para poder saber en cualquier momento desde el movil por ejemplo cual es la IP dinámica actual.

Gracias

MODIFICO ESTE PRIMER MENSAJE POR SI A ALGUIEN LE SIRVE EL SISTEMA, ES MUY SIMPLE

Dim Ip As String
Ip = WebBrowser1.Document.documentElement.innertext

Así de fácill

Hola:

Yo he probado este ejemplo y funciona:

Private Sub Command1_Click()
  Me.Hide
  Me.WindowState = vbMinimized
  Dim ciclo As Long, bucle As Long
  DoEvents
  For ciclo = 1 To 10000
    For bucle = 1 To 10000
    Next
  Next
  Me.Visible = True
  Me.WindowState = vbNormal
End Sub
Se me ocurre que antes de hacer el WindowState debes hacer el Visible como en mi ejemplo

Prueba y comenta

No, cuando se adquieiron las tablets Acer Iconia W500 eran y son con Windows 7 y fue la mejor opcion ya que no me atreví a programarlas de otra manera.

El comentario era por la referencia a la posible alternativa en escritorio remoto que funciona perfectamente y desde el ANDROID se manejan los programas a traves del servidor Windows.

Por otra parte estoy tambien bastante interesado en el tema, porque el dia que deba hacer una sustitucion a ver como me las apaño.

Saludos

Hola, en una ocasión estuve buscando algo similar y no llegué a encontrar la manera de ocultar .Exec, sólo se puede hacer con el .Run

Si te parece esta es una opcion:

Function ejecutar_Dos(Comando As String) As String
    Dim oShell As WshShell
    Dim Fichero As Integer
    Set oShell = New WshShell
    oShell.Run "%comspec% /c " & Comando & " >salida.tmp", 0, True
    Fichero = FreeFile
    Open "salida.tmp" For Input As #Fichero
    ejecutar_Dos = Input(LOF(Fichero), #Fichero)
    Close #Fichero
    Kill "salida.tmp"
End Function
No se si te puede valer en todos los casos pero utilizando el redireccionador de D.O.S., puedes crear un archivo temporal con el contenido de los datos y devolverlo después.

El .Run te permite determinar el tipo de Ventana y si o no debe esperar a terminar.

Saludos

Hola, una opcion muy simple es guardar el archivo Excel en formato CSV, lo que en tu caso crearía algo similar a esto
ABBA xxxxxxxxx;Caseros;0000;40005;SAN CRISTOBAL
ABBA xxxxxxxxx;Caseros;0000;40007;SAN CRISTOBAL

El proceso intermedio a lo que tu deseas sería un LINE INPUT para leer el Secuencial y guardarlo mas o menos así
Print #1, CHR$(34);Replace(Linea, ";"; CHR$(34) & "," & CHR$(34)); CHR$(34)

Creo que podría funcionar

Saludos


Teniendo en cuenta que el CSV viene separado por ; esta ejemplo funciona

Private Sub Command1_Click()
  Open "C:\Libro1.csv" For Input As #1
  Open "C:\Libro1.txt" For Output As #2
  While Not EOF(1)
    Line Input #1, linea
    Print #2, Chr$(34) & Replace(linea, ";", Chr$(34) & "," & Chr$(34)) & Chr$(34)
 Wend
 Close #1, #2
End Sub

Esta conversión que indico es porque (por lo menos en mi caso) no se si siempre es así o depende de la configuracion regional, el excel me crea el CSV con campos separados por PUNTO Y COMA, y creo que lo necesitas separados con COMA y entrecomillados.

Veo que en el enlace SIGUIENTE que a puesto Raul, el ejemplo indica los valores: 2008,"E1A",MIGUEL,JORQUERA y mi excel 2003 me crea el csv como 2008;E1A;MIGUEL;JORQUERA

Reedito para confirmar esto:
Para modificar el delimitador (separador) por defecto en Excel sólo tendremos que modificar el del mismo sistema.

He tenido necesidad de implementar un AJUSTE de texto en unos documentos y aunque no llega a la perfección del Word y similares (ni se les acerca siquiera), he conseguido desarrollar esta función que cumple gran parte de su cometido.

Como es muy simple y no es mucho código, a fin de no tener que adjuntar un archivo copia aqui la funcion con un ejemplo de uso de la misma.

Public Function JustificaTexto(ByVal Texto As String, Ancho As Integer, Hacia As Object) As String
  ' Justifica (mas o menos) el texto indicado. No es el de Office ni hace milagros pero puede servir.
  ' Recibe....: Texto a Autoajustar, Ancho deseado, Objeto que recibirá el texto
  ' Devuelve..: Lineas separadas por CrLf y ajustada al ancho deseado
  Dim Todo As String, Desde As Integer, Hasta As Integer, Previo As Integer, Linea As String, Parte As String
  Dim Posicion As Integer, Insertar As Boolean, HayBlancos As Boolean, Intro As Integer
  Dim Objeto As Object
  Set Objeto = Hacia
  Todo = RTrim$(Texto) & Chr$(32)  ' Añade al final un caracter en blanco
 
TieneIntros:
  ' Comprueba si es un texto Multi-Párrafo
  Intro = InStr(Todo, vbCrLf)
  If Intro > 0 Then
    Parte = Left$(Todo, Intro - 1)
    Todo = Mid$(Todo, Intro + 2)
    JustificaTexto = JustificaTexto & JustificaTexto(Parte, Ancho, Hacia)
    GoTo TieneIntros
  End If
 
  Do
    If InStr(Todo, Chr$(32)) = 0 Then
      JustificaTexto = JustificaTexto & Todo & vbCrLf
      Exit Do
    End If
    Desde = 1
MasAun:
    Hasta = InStr(Desde, Todo, Chr$(32))
    If Objeto.TextWidth(Left$(Todo, Hasta - 1)) < Ancho Then
      Previo = Hasta  'El último corte que encaja en el ancho
      Desde = Hasta + 1
      If Hasta < Len(Todo) Then GoTo MasAun
    End If
    Linea = RTrim$(Left$(Todo, Previo - 1))
    Todo = LTrim$(Mid$(Todo, Previo + 1))
    ' Ajusta con blancos la linea para igualar al máximo
Ajustar:
    Posicion = 1
    If InStr(Linea, Chr$(32)) > 0 Then HayBlancos = True Else HayBlancos = False
    Insertar = False
    Do
      If Not HayBlancos Then Exit Do
      If Mid$(Linea, Posicion, 1) <> Chr$(32) Then
        Insertar = True
      Else
        If Insertar Then
          Linea = Left$(Linea, Posicion) & Chr$(32) & Mid$(Linea, Posicion + 1)
          Insertar = False
          If Objeto.TextWidth(Linea) >= Ancho Then Exit Do
        End If
      End If
      If Posicion = Len(Linea) Then Exit Do
      Posicion = Posicion + 1
    Loop
    If Objeto.TextWidth(Linea) < Ancho And HayBlancos And Todo <> "" Then GoTo Ajustar
    JustificaTexto = JustificaTexto & Linea & vbCrLf
  Loop
  Set Objeto = Nothing
End Function
Aqui código del ejemplo Pic es un PictureBox, txtTexto es un TexBox multilinea y Ajustar es un Slider para probar diversos Anchos

Option Explicit

Private Sub Form_Load()
  txtTexto = vbTab & "Esta texto es la prueba para comprobar esta función de Justificacion de Texto, no pretende sustituir"
  txtTexto = txtTexto & " la función de los editores profesionales, ya que no controla los cambios de Fuente, Tamaño,"
  txtTexto = txtTexto & " negrita dentro del mismo texto, pero en algunas circunstancias creo que puede valer, por lo"
  txtTexto = txtTexto & " menos a mi me vale. Puede no estar exento de errores, de hecho estoy seguro que tiene alguno,"
  txtTexto = txtTexto & " por lo que se aceptan mejoras al mismo. Un saludo a todos."
  txtTexto = txtTexto & vbCrLf
  txtTexto = txtTexto & vbTab & "Para probar su funcionamiento basta con ir desplazando la barra con el fin de determinar el ancho."
  txtTexto = txtTexto & vbCrLf
  txtTexto = txtTexto & vbTab & "Se ha modificado porque había un error si incluíamos CrLf en el texto. Antes sólo editaba bien"
  txtTexto = txtTexto & "un párrafo y sin embargo con esta modificacion ajusta bien un texto en el que se pueden indicar"
  txtTexto = txtTexto & "diferentes párrafos con el CrLf para separarlos. Tambien se ha comprobado su funcionamiento si lleva"
  txtTexto = txtTexto & "insertado entre el texto Tabulaciones vbTab, espero que no haya mas cambios"
  txtTexto = txtTexto & vbCrLf & vbCrLf
  txtTexto = txtTexto & vbTab & "En la linea anterior se ha incluido un doble Intro CrLf para probar su funcionamiento"
 
  Ajustar.Max = Pic.Width
  Ajustar.Min = 1000
  Ajustar.Value = Pic.Width \ 3
End Sub

Private Sub Ajustar_Click()
  Pic.Cls
  Pic.Print JustificaTexto(txtTexto, Ajustar.Value, Pic)
End Sub
Saludos y ojalá le sirva a alguien.

pd: He tenido que aplicar una modificación porque de la manera anterior sólo justificaba correctamente el primer párrafo de un texto. De este modo justifica todos los párrafos considerando los mismos si estan separados por CrLF. Asi mismo he verificado el correcto funcionamiento de vbTab en el Texto.