Macro para copiar celdas

Amigo recuerda el programa de copiar lo de una celda en una columna de la hoja 2 lo que pasa es que los datos que recibo son del puerto serie del pc el programa funciona bien cuando uno los introduce desde teclado pues porque uno le da enter y se pasan correctamente a la hoja2 no hay alguna posibilidad de que el programa me los copie sin necesidad de darle enter a cada dato que se introduce.
Option Explicit
Dim snCambioB5 As Boolean
Private Sub Worksheet_Activate()
    snCambioB5 = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    snCambioB5 = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Copiamos el valor en la hoja 2
    If snCambioB5 Then copiaValorB5enHoja2 Cells(5, 2): snCambioB5 = False
    ' Para que no se mueva de la celda B5 de la Hoja1
    Sheets("Hoja1").Select
    Cells(5, 2).Select
End Sub
Private Sub copiaValorB5enHoja2(ByVal valorB5)
    Dim nLin As Long
    If IsNull(valorB5) Or valorB5 = "" Then Exit Sub
    ' Buscaremos de forma rápida la última línea grabada
    ' Primero de 1000 en 1000 hasta que no haya nada
    nLin = 2
    Do While Sheets("Hoja2").Cells(nLin, 2) <> ""
        nLin = nLin + 1000
    Loop
    ' Volvemos hacia atras de 25 en 25 hasta que haya una ocupada
    Do While Sheets("Hoja2").Cells(nLin, 2) = ""
        If nLin > 25 Then nLin = nLin - 25 Else Exit Do
    Loop
    ' Y buscamos de 1 en 1 hacia delante hasta que haya una libre
    Do While Sheets("Hoja2").Cells(nLin, 2) <> ""
        nLin = nLin + 1
    Loop
    ' nLin contiene el primer número de línea vacío. Guardamos el valor ahí
   Sheets("Hoja2").Cells(nLin, 2) = valorB5
   Sheets("Temperaturas").Cells(nLin, 3).NumberFormat = "dd-mm-yyyy / hh:mm:ss"
    Sheets("Temperaturas").Cells(nLin, 2) = valorB2
End Sub
Gracias
Respuesta
1
Supongo que estarás recibiendo los datos desde un lector de códigos de barras o algo similar.
En cualquier caso, lo que está claro es tienes que detectar cuando se acaba de recibir el dato para poder mandarlo a la hoja2. No puedes enviar la información cada vez que entre un número sino cuando esté en número completo.
Desde aquí es un poco complicado porque sería necesario ver un par de cosillas para darte una solución a la primera.
Si el largo de todos los códigos es el mismo, la solución podría estar en comprobar la longitud y ejecutar el procedimiento cuando estuviese todo. Esto se haría con una instrucción como la siguiente:
if len(sheets("Hoja1").cells(5,2))= <el largo que sea> then copiaValorB5enHoja2 Cells(5, 2): snCambioB5 = False
Esto lo tendrías que incluir al final del 'Private Sub Worksheet_Change(ByVal Target As Range)', antes del 'end sub'.
Si esto no funciona, lo que tendrás que haces es controlar los caracteres que te llegan por el puerto serie para saber si hay algún carácter raro. Haz lo siguiente: En lugar de incluir la línea que te he puesto antes, incluye estas otras:
dim i
for i = 1 to len(sheets("Hoja1").cells(5,2))
    debug.print asc(mid$(sheets("Hoja1").cells(5,2),i,1)),"";
next i
Debug. Print " "
En la ventana de inmediato (si no la ves pulsa <Ctrl><G>), te aparecerán una serie de tiras de números cuando utilices el lector. Envíame las tiras que aparezcan al leer cuatro o cino códigos y veremos lo que se puede hacer.
De momento poco más puedo contarte.
Hola amigo me gustaría que si es posible me dieras tu msn para poder hablar mejor y así poderle encontrar la solución a mi problema aunque si no se puede te voy a contar por aquí, mira tengo una red de dispositivos 1-wire estos dispositivos me arrojan una temperatura un numero de serie y otras informaciones, estos dispositivos están conectados al pc por medio de un comvertidor de protocolo 1-wire a serie este convertidor lo conecto al pc y por medio de una software llamado DDEView puedo ver toda estas información de la red por medio de este programa hay un modo de exportar los datos a excel con una simple linea que puedo ubicar en la casilla que yo quiera en este caso la B5 que es donde tengo la temperatura del dispositivo y la función es esta =MyDDE|Value!THERMO1_ReadT (esta función es solo para leer la temperatura, se copia y se pega en la celdase luego da enter y ya la temperatura aparece en la celda y me va cambiando según la temperatura ambiente ) existen otras funciones como por ejemplo el numero de serie del dispositivo, si esta en linea o no, entre otros pero para este caso no hay problema puesto que con solo poner la función correspondiente tengo el dato en la celda y a diferencia del de la temperatura no va cambiando. En este link puedes ver lo que te estoy contado de una manera más detallada y completa http://www.roso-control.com/Espanol/DDEVIEW/Esp_DDEVIEW.htm
Gracias amigo por su interés mi mail es [email protected]
Ha he probado lo que me dijiste y con esta linea if len(sheets("Hoja1").cells(5,2))= <el largo que sea> then copiaValorB5enHoja2 Cells(5, 2): snCambioB5 = False no se a que te refieres con lo de el largo que sea.
Y con las otras instrucciones no parece nada de lo que me dijiste
Gracias
Oye si puedes ver el los ejemplos en excel que están en el link que te pase para que tomes una mejor idea de lo que te comente, en esos ejemplos hay varios sensores pero el mio es el DS18s20 espero te sirva para una parapoderme dar una mejor ayuda gracias y perdón tanta molestia. Es que para mi esto es importante puesto que es parte de mi proyecto de grado de IG. Electrónica.
No tengo msn. El único programa que utilizo 'muy de tarde en tarde' para comunicarme con otras personas es el skype.
A ver si puedo darte alguna pista para que resuelvas el problema.
Lo primero que tenemos que conseguir adivinar es: ¿Cómo podemos saber que ha entrado una temperatura nueva?
Cuando estamos tecleando, el valor termina cuando pulsamos <enter> o bien nos movemos a otra celda por medio de cualquier tecla. En este caso podemos usar el evento 'chage'. Pero el problema que aparece ahora es que los datos vienen a través de un intercambio 'dde' y no se nos activa ese evento.
Lo que yo haría es lo siguiente: entraría en el editor de Visual Basic y en la parte del código de la "hoja1" seleccionaría todos los eventos poniendo un mensaje en cada uno de ellos. El código sería el siguiente:
Option Explicit
Private Sub Worksheet_Activate()
    MsgBox "Worksheet_Activate"
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    MsgBox "Worksheet_BeforeDoubleClick"
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    MsgBox "Worksheet_BeforeRightClick"
End Sub
Private Sub Worksheet_Calculate()
    MsgBox "Worksheet_Calculate"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    MsgBox "Worksheet_Change"
End Sub
Private Sub Worksheet_Deactivate()
    MsgBox "Worksheet_Deactivate"
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    MsgBox "Worksheet_FollowHyperlink"
End Sub
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    MsgBox "Worksheet_PivotTableUpdate"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    MsgBox "Worksheet_SelectionChange"
End Sub
Cuando entre una nueva temperatura podrás saber qué eventos se disparan y elegir uno para que realice tu proceso de copia a la hoja2.
Si esto no funcionase a nivel de la página, habría que probarlo a nivel de libro haciendo algo similar en el código de thisWorkBook. Algo así:Option Explicit
Private Sub Workbook_Activate()
    MsgBox "Workbook_Activate"
End Sub
Private Sub Workbook_AddinInstall()
    MsgBox "Workbook_AddinInstall"
End Sub
Private Sub Workbook_AddinUninstall()
    MsgBox "Workbook_AddinUninstall"
End Sub
Private Sub Workbook_AfterXmlExport(ByVal Map As XmlMap, ByVal Url As String, ByVal Result As XlXmlExportResult)
    MsgBox "Workbook_AfterXmlExport"
End Sub
...
...
...
De momento no se me ocurren más posibilidades.
Esta semana voy a estar fuera y no voy a poder entrar más por aquí. Si continuas con el problema, a partir del próximo lunes, hacemos más pruebas.
Esta pregunta lleva una semana activa sin ningún comentario.
Si no tienes más que preguntar sobre el tema, ciérrala para que deje de estar pendiente.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas