Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - pkj

#21
Pues es bastante simple, pero tienes que usar variables de tipo Date o al menos de tipo String para guardar el valor.

Código (vb) [Seleccionar]

 Dim Dia1 As String
 Dia1 = "06/06/2015" ' fecha de entrada guardada
 MsgBox DateDiff("d", CDate(Dia1), DTPicker1.Value)  ' diferencia con la fecha actual


;)

Saludos
#22
Esta vez vas a tener que pensar mas :D
Cuando entras al hotel guardas la fecha en una variable mirando el valor del DTPcker ese.
Cuando sales comparas la fecha actual con la guardada.
Para compararla te puede servir el comando datediff. Investiga un poco. Usa "San Google" :D

Saludos
#23
Puedes intentar modificar un poco la funcion.
A mi a veces me pasa tambien eso y mira que j.de.

Aqui te dejo tu funcion "traducida" y con un par de lineas cambiadas de posicion.
Quiza te valga, aunque no responde igual que Split con caracteres ASCII extendido.

Código (vb) [Seleccionar]

Private Function Separa(ByVal Cadena As String, Optional ByVal Separador As String, Optional ByVal Limite As Long = -1) As String()
 
 Dim SiguienteCaracter As Long, PosSeparador As Long, LenCadena As Long, LenSeparador As Long, Contador As Long, MatrizAcumulador() As String
 
 LenCadena = Len(Cadena)
 If LenCadena = 0 Then GoTo QuitHere
 If Separador = vbNullString Then Separador = " "
 If Limite = 0 Then GoTo QuitHere
 If InStr(1, Cadena, Separador, vbBinaryCompare) = 0 Then GoTo QuitHere

 
 LenSeparador = Len(Separador)
 
 ReDim MatrizAcumulador(0)
 SiguienteCaracter = 1
 PosSeparador = 1
 
 Do
   If Contador + 1 = Limite Then
     MatrizAcumulador(Contador) = Mid$(Cadena, SiguienteCaracter)
     Exit Do
   End If
   
   PosSeparador = InStr(PosSeparador, Cadena, Separador, vbBinaryCompare)
   
   If PosSeparador = 0 Then
     If Not SiguienteCaracter = LenCadena Then
       MatrizAcumulador(Contador) = Mid$(Cadena, SiguienteCaracter)
     End If
     Exit Do
   End If
   
   MatrizAcumulador(Contador) = Mid$(Cadena, SiguienteCaracter, PosSeparador - SiguienteCaracter)
   Contador = Contador + 1
   
   ReDim Preserve MatrizAcumulador(Contador)
   
   SiguienteCaracter = PosSeparador + LenSeparador
   PosSeparador = SiguienteCaracter
 Loop
 
 ReDim Preserve MatrizAcumulador(Contador)
 Separa = MatrizAcumulador
 
 Exit Function
 
QuitHere:
 ReDim Separa(-1 To -1)

End Function


Yo me he estado dejando un poco el seso y te he hecho esta otra, que aunque tarda 3 veces mas que la tuya, en miles y miles de pruebas aleatorias me ha dado el mismo resultado que Split.

Que la disfruteis:

Código (vb) [Seleccionar]
Private Function Separa3(ByVal Cadena As String, ByVal Separador As String, Optional ByVal Limite As Long = -1) As String()
 Dim Contador As Long
 Dim ContadorB As Long
 Dim F As Long
 Dim F2 As Long
 Dim Chr0 As Long
 Dim Matriz() As String
 Dim MatrizB() As Byte
 Dim CadenaB() As Byte
 Dim SeparadorB() As Byte
 Dim LenSepB As Long
 Dim LenCadenaB As Long
 
 ' EL ORDEN DE ESTAS COMPARACIONES ES IMPORTANTE
 ' PARA OBTENER EL MISMO RESULTADO QUE SPLIT
 ' PERO MUY, MUY IMPORTANTE :P
 LenCadenaB = LenB(Cadena)
 If Separador = "" Then GoTo Error2 ' si no hay separador se devuelve hasta un chr(0)
 If Limite = 0 Then GoTo Error1 ' si limite es 0 se devuelve vacia
 If LenCadenaB = 0 Then GoTo Error1 ' si no hay cadena se devuelve vacia
 If Limite = 1 Then GoTo Error3 ' si limite es 1 se devuelve todo en una matriz con 1 elemento
 If InStr(1, Cadena, Separador, vbBinaryCompare) = 0 Then GoTo Error3
 'si no se encuentra el separador se devuelve una matriz de 1 solo elemento con todo
 
 CadenaB = Cadena
 
 SeparadorB = Separador
 LenSepB = LenB(Separador)
 
 Contador = -1 ' este controla los elementos de Matriz
 ContadorB = 1 ' este controla los elementos de MatrizB
 
 For F = 0 To LenCadenaB - 1 Step 2 ' vamos eligiendo cada caracter
   
   If F + LenSepB <= LenCadenaB Then ' si cabe un separador miramos si lo hay
     For F2 = 0 To LenSepB - 1 Step 2
       If CadenaB(F + F2) <> SeparadorB(F2) Then
         Exit For ' no lo hay
       
       ElseIf CadenaB(F + F2 + 1) <> SeparadorB(F2 + 1) Then
         Exit For ' no lo hay
       
       End If
     Next F2
   
   Else
     
     ' si no cabe el separador, no hay separador. marcamos F2
     F2 = 0
   
   End If
   
   If F2 < LenSepB - 1 Then
   ' si no habia separador guardamos el byte
     ReDim Preserve MatrizB(ContadorB)
     MatrizB(ContadorB - 1) = CadenaB(F)
     MatrizB(ContadorB) = CadenaB(F + 1)
     ContadorB = ContadorB + 2
   
   Else
   ' si habia separador
     
     If Contador + 1 <> Limite Then
     ' si no hemos llegado al limite
       F = F + LenSepB - 2 ' apuntamos mas alla del separador
       Contador = Contador + 1 ' creamos un nuevo elemento y guardamos lo extraido
       ReDim Preserve Matriz(Contador)
       If ContadorB > 1 Then Matriz(Contador) = MatrizB
       ContadorB = 1 ' inicializamos la matrizb
       ReDim MatrizB(1)
     Else
     ' si hemos llegado al limite salimos
       Exit For
     End If
     
   End If
 Next F
   
 If (Contador + 1 = Limite) Then
   ' si estamos en el limite
     
   If F = LenCadenaB Then
    ' si hemos procesado toda la cadena, es que no habia
    ' separador y tenemos todo en matrizb, asi que lo
    ' guardamos en este ultimo elemento
     If ContadorB > 1 Then ' aun asi, el separador puede ser el ultimo caracter
       Matriz(Contador) = Matriz(Contador) & Separador & CStr(MatrizB)
     Else
       Matriz(Contador) = Matriz(Contador) & Separador
     End If
   
   Else
     ' si aun quedan caracteres es que habia separador
     ' hay que sacar los que quedan e incluir el separador
     For F2 = F To LenCadenaB - 1 Step 2
       ReDim Preserve MatrizB(ContadorB)
       MatrizB(ContadorB - 1) = CadenaB(F2)
       MatrizB(ContadorB) = CadenaB(F2 + 1)
       ContadorB = ContadorB + 2
     Next F2
     Matriz(Contador) = Matriz(Contador) & Separador & CStr(MatrizB)
     
   End If
 
 Else
   ' si quedan casillas creamos una nueva
   Contador = Contador + 1
   ReDim Preserve Matriz(Contador)
   ' si hay algo en matrizb lo guardamos
   If ContadorB > 2 Then Matriz(Contador) = MatrizB
 
 End If
   
 Separa3 = Matriz  ' y devolvemos la matriz

 GoTo FinFunction

Error1:
 ReDim Separa3(-1 To -1) ' aqui devolvemos la matriz vacia
 GoTo FinFunction
 
Error2:
 ' si no hay separador, Split usa chr(0) como fin de cadena.
 ' si no lo encuentra devuelve toda la cadena.
 Chr0 = InStr(1, Cadena, Chr(0))
 If Chr0 <> 0 Then
   Cadena = Left$(Cadena, Chr0 - 1)
 End If
 
Error3:
 ' aqui la devolvemos en un solo elemento
 ReDim Matriz(0)
 Matriz(0) = Cadena
 Separa3 = Matriz
 
FinFunction:

End Function


Saludos

EDITO:
Parece que me falto probar sin separador y si no lo hay no da el mismo resultado que Split.
Depurando.....

EDITO2:
Arreglado, (o eso creo). Espero que vaya bien, porque no pienso volver a revisarla.
La he probado con valores aleatorios y nulos para cadena, separador y limite.
Os dejo los comentarios que he ido escribiendo para que los mas nuevos se enteren de algo.

EDITO3:
Dios mio, porque lo he vuelto a revisar.
Por no hacer un Randomize, parece ser que las pruebas no eran del todo aleatorias.
Resulta que hay al menos 1 excepcion (que investigare), y es que si el caracter separador es el Chr(7) si que falla. Devuelve diferente resultado que la funcion Split.
Vere si lo arreglo. Si no, a mi ya me parece bastante bueno  :rolleyes:

Y SIGO EDITANDO:
El problema es el limite. Parece que si hay limite falla. No se que m,, de pruebas aleatorias he hecho :P
El caracter 7 me salia como separador siempre con limite 2, asi que siempre fallaba. Por lo visto como tenia un margen muy grande para limite, con los demas caracteres no llegaba al limite.
Seguire depurando a ver. Es mas complicado de lo que parece  :-\

OTRA VEZ AQUI:
Listo, ya funciona (otra vez). Solo habia un par de calculos que habia deducido mal. Volveré cuando vea que lo he estado probando todo el rato con la misma cadena o vete a saber :D

Y OTRA VEZ:
Ya lo adverti. Ahora habia olvidado probar con cadenas vacias (creo) y con separadores que no existieran en la cadena. Ademas la funcion Split es muy suya y cuesta descubrir como va a decidir devolverte el resultado con parametros no validos.

En fin, las pruebas "aleatorias" dicen que ya funciona bien, y yo ya estoy cansado de hacer pruebas :P

Si encontrais errores comentadmelo.

Saludos
#24
Te saldran siempre los mismos precios.
Tienes que poner otra comparacion
Código (vb) [Seleccionar]

Private Sub Combo3_Click()
If Combo3.Text = "2013" Then
  If Combo2.Text = "Accord" Then
    lblUS = "28,900"
  ElseIf Combo2.Text = "Civic" Then
    lblUS = "xx,xxx"
  End If
ElseIf Combo3.Text = "2014" Then
  If Combo2.Text = "Accord" Then
    lblUS = "32,000"
  ElseIf Combo2.Text = "Civic" Then
    lblUS = "xx,xxx"
  End If
Elseif...

etc...
#25
Vas bien, pero en lugar de asignar valores al combo.text tienes que:

Vaciar el combo con combo.clear

Añadir los elementos con combo.add (o combo.additem no me acuerdo) segun sea la marca.

Saludos
#26
Estas usando mal el label. No puedes preguntar si un label es true o false.
No deberia pasar de esa linea sin dar error.

Pon un breakpoint al comienzo de esa sub y, cuando se pare, sigue el proceso paso a paso con F8.
Asi podras ver donde se muestra el form.

Es muy probable que al generarse el error del label el programa salte al ultimo error controlado y este esté en el form2.

Con F8 lo descubriras.

Suerte
#27
Yo tengo un problema parecido. Tengo un disco que de vez en cuando se activa y pega unos latigazos que no me gustan nada. Como casi no lo uso lo apago usando el programa revoSleep, y cuando realmente lo quiero usar lo reactivo.
No me gusta demasiado la solución, ademas de que el programa es algo chapuza, pero normalmente me paso todo el día sin reactivarlo, asi que creo que sufrirá menos que dando latigazos cada x tiempo.
Si usas Win7 y quieres usarlo, ejecútalo como Administrador o no podrá manipular los discos.

Saludos

#28
No se a que te refieres que quieres hacer, puesto que ya conoces el FormatCurrency.
Por si acaso, aqui he dejado una descripcion del comando:
http://foro.elhacker.net/programacion_visual_basic/pregunta_simple-t436432.0.html

Saludos
#29
Aqui lo tienes para vb6:
http://www.vb-helper.com/howto_formatcurrency.html

Una pequeña traduccion Google y algo de explicacion:

    FormatCurrency(expression _
        [, digits_after_decimal] _
        [, include_leading_zero] _
        [, use_parens_if_negative] _
        [, groups_digits] )


Parametros:

expression
expresión numérica

digits_after_decimal
El número de dígitos a mostrar después del punto decimal

include_leading_zero
Si el número es menor que 1 y mayor que -1, determina si el número debe tener un 0 antes del punto decimal.

use_parens_if_negative
Determina si los números negativos están rodeados con paréntesis en lugar de utilizar un signo menos.

groups_digits
Determina si los dígitos a la izquierda del punto decimal se agrupan con separadores de miles (comas en los Estados Unidos).

Ejemplos:

Resultado = FormatCurrency(1.23456, 2) ' devuelve $1.23 con solo 2 decimales

Resultado = FormatCurrency(0.123456, 2, vbFalse) ' devuelve $.12 sin cero a la izquierda

Resultado = FormatCurrency(0.123456, 2, vbTrue)  ' devuelve $0.12 con cero a la izquierda

Resultado = FormatCurrency(-12345.12, , vbFalse) 'devuelve $-12,345.12  valores negativos con signo -

Resultado = FormatCurrency(-12345.12, , vbTrue) 'devuelve ($12,345.12)  valores negativos entre parentesis

Resultado = FormatCurrency(-12345.12, , vbTrue, vbFalse) 'devuelve ($12345.12) sin separadores de millar

Saludos
#30
Es simple. Suponiendo que tu listbox se llame List1:
Creas un bucle For Next de 0 a List1.ListCount-1
Vas sumando todos los valores que vaya adquiriendo List1.List(contadordelbucle) y cuando acabe el bucle divides el resultado entre List1.ListCount.
Intenta hacerlo y pregunta si tienes dudas.

Saludos