Leer código de Barras o 2D Data Matrix Code, colocarlo hacia abajo y Colorear Código de Barras

Estoy buscando ayuda para realizar una macro que de una celda fija copie el dato que un escáner arrojara en ella y lo copie hacia abajo y se vayan desplazando descendentemente los datos conforme se van copiando, también que se pueda llenar de color la celda que contenga un dato de código de barras o diferente de menos dígitos que las demás celdas.

1 respuesta

Respuesta
1

Creé la siguiente aplicación para capturar código de barras, es algo sencilla y practica, abres un formulario, capturas la columna y la fila a partir de la cual quieres que empiecen los códigos de barra y de ahí hacia abajo se van capturando.

https://www.dropbox.com/s/kslh4mgog3q7l7r/ingresar%20cod%20barras2.xlsm?dl=0 

Prueba y me comentas qué cambios necesitas.

Saludos. Dante Amor

Si es lo que necesitas.

Hola Dante

Muchas Gracias por este archivo que me enviaste si me funciona, el problema que yo tengo es que tengo un escáner esta fijo en mi línea de producción este escanea y tiene que procesar los datos inmediatamente el operador no tiene tiempo de abrir el formulario y muchas veces no saben operar la PC solamente pasan el DMC o Código de Barras por el scanner, ¿te podría compartir una macro que yo hice para esto y me podrías ayudar a modificarla para que después de cada 45 piezas escaneadas te salga un letrero o una indicación que debes meter manualmente algún numero y después ya continuar con la captura de otras 45 piezas?

Envíame tu archivo y me explicas paso a paso cómo funciona.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Jovanny Sosa” y el título de esta pregunta.

Te acabo de enviar el archivo espero me puedas ayudar

Te anexo la macro actualizada, la idea es que después de que capturan 45 piezas aparezca el mensaje.

Sub U()
'Act.Por Dante Amor
    Application.ScreenUpdating = False
    Sheets("DB").Select
    Range("I6:K6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range("E5:F5").Copy
    Range("I6").PasteSpecial Paste:=xlPasteValues
    Range("C5").Copy
    Range("K6").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Sheets("Tabelle1").Select
    Range("A2").Select
    ActiveWorkbook.Save
    For i = 6 To Sheets("DB").Range("I" & Rows.Count).End(xlUp).Row
        cont = cont + 1
        If cont >= 45 Then
            MsgBox "Se han agregaron 45 pieazas, debe introducir un HU o un código de barras manual", vbExclamation
            Exit Sub
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Saludos.Dante Amor

Si es lo que necesitas.

Si si me funciona muchas gracias, pero aun tengo un pequeño problema es que debe de reiniciar la cuenta desde 0 hasta 45 de nuevo para que así se consecutivo que cada 45 escribas el dato y después te vuelva a salir el mensaje y después borrar otra vez cuando se introduzca el dato del HU, no se si se podría hacer que cada que se introduzca un dato de 12 caracteres o 25 etc es igual, se vuelva el contador a 0 y volver a contar 45 para así volver a empezar el ciclo.

Te anexo la macro para que cuando llegue a 45 se borren los códigos introducidos y empiece nuevamente en 1.

Sub U()
'Act.Por Dante Amor
    Application.ScreenUpdating = False
    Sheets("DB").Select
    Range("I6:K6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range("E5:F5").Copy
    Range("I6").PasteSpecial Paste:=xlPasteValues
    Range("C5").Copy
    Range("K6").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    For i = 6 To Sheets("DB").Range("I" & Rows.Count).End(xlUp).Row
        cont = cont + 1
        If cont >= 45 Then
            MsgBox "Se han agregaron 45 pieazas, debe introducir un HU o un código de barras manual", vbExclamation
            Range("I6:K" & i).ClearContents
        End If
    Next
    Sheets("Tabelle1").Select
    Range("A2").Select
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub

Hola dante ya cambie la macro pero al momento de correrla me sale un mensaje donde dice "se ha detectado un nombre ambiguo: U" este mensaje no salia sabes a q se refiere?

Tienes 2 macros con el mismo nombre "U", borra la macro anterior y solamente deja la última macro que te envié.

Si ya no sale ese letrero, pero lo que vi en la nueva macro es que no guarda ya los datos cuando termina el conteo de las 45 piezas borra todo lo de la otra hoja donde lleva la base de datos y no guarda ya nada, como es que se puede hacer para que no borre todo y haga lo que hace hasta ahorita la macro pero sin borrar el contenido de la pestaña del DB.

¿Y dónde quieres que lo guarde?

Pediste un contador de 1 a 45 y cuando llegue a 45 que borre los datos y empiece desde 1

Si el contador esta bien, pero al copiar a la hoja DB que se quede ahí archivado el dato solamente recorriéndose hacia abajo nada más, pero al mismo tiempo tener el contador, sin que borre nada de los datos.

Te cambio la macro

Sub U()
'Act.Por Dante Amor
    Application.ScreenUpdating = False
    Sheets("DB").Select
    Range("I6:K6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range("E5:F5").Copy
    Range("I6").PasteSpecial Paste:=xlPasteValues
    Range("C5").Copy
    Range("K6").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    [H5] = [H5] + 1
    If [H5] >= 45 Then
        MsgBox "Se han agregaron 45 pieazas, debe introducir un HU o un código de barras manual", vbExclamation
        [H5] = 0
    End If
    Sheets("Tabelle1").Select
    Range("A2").Select
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub

Saludos.Dante Amor

Hola Dante

Disculpa por tanta duda pero ahora no sale el mensaje a las 45 piezas no se porque.

Te envié mi archivo para que lo revises.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas