Pescaderías

Mapa: Comunas prioritarias y competencia estimada. Fuente: búsquedas públicas. Si el mapa aparece en blanco, asegúrate de permitir la carga de recursos externos (CDN).

Funciones VBA Excel

Como comenté anteriormente, en mi trabajo no cuento mas que con Excel para desarrollos. Se me solicito generar una etiqueta dinámica en base a datos en distintas sheets(hojas).

Public Sub Genera() 'Funcion principal.
Dim equipo As String, modelo As String, pm As String, conca As String, faena As String, horaaceite As String, rango1 As String, rango2 As String
Dim i As Integer, x As Integer, contador As Integer
Dim LArray() As String

equipo = Sheets.Item("DATOS MANUALES").Cells(2, 4).Value
pm = Sheets.Item("DATOS MANUALES").Cells(4, 4).Value
horo = Sheets.Item("DATOS MANUALES").Cells(6, 4).Value
fecha = Sheets.Item("DATOS MANUALES").Cells(8, 4).Value
respo = Sheets.Item("DATOS MANUALES").Cells(10, 4).Value

conca = BuscaModelo(equipo)
LArray = Split(conca, "/")
modelo = LArray(0)
faena = LArray(1)
serie = LArray(2)

    limpiar
    limpiarBordes
    borrarImagen
        
contador = 3
For i = 2 To 5000
    imodelo = Sheets.Item("MATRIZ MUESTRAS").Cells(i, 1).Value
    ipm = Sheets.Item("MATRIZ MUESTRAS").Cells(i, 2).Value
    If ((StrComp(modelo, imodelo) = 0) And (StrComp(pm, ipm) = 0)) Then
        icomponente = Sheets.Item("MATRIZ MUESTRAS").Cells(i, 4).Value
        iaceite = Sheets.Item("MATRIZ MUESTRAS").Cells(i, 5).Value
        icambio = Sheets.Item("MATRIZ MUESTRAS").Cells(i, 6).Value
        ilaboratorio = Sheets.Item("MATRIZ MUESTRAS").Cells(i, 7).Value
        
        'aqui se generan las plantillas
        Sheets.Item("ETIQUETAS").Cells(contador, 1).Value = "MUESTRA DE ACEITE"
        
        Sheets.Item("ETIQUETAS").Cells(1 + contador, 1).Value = "Faena"
        Sheets.Item("ETIQUETAS").Cells(2 + contador, 1).Value = "Equipo"
        Sheets.Item("ETIQUETAS").Cells(3 + contador, 1).Value = "Horometro"
        Sheets.Item("ETIQUETAS").Cells(4 + contador, 1).Value = "Horas de aceite"
        Sheets.Item("ETIQUETAS").Cells(5 + contador, 1).Value = "Fecha de Muestra"
        Sheets.Item("ETIQUETAS").Cells(6 + contador, 1).Value = "Modelo"
        Sheets.Item("ETIQUETAS").Cells(7 + contador, 1).Value = "Compartimento"
        Sheets.Item("ETIQUETAS").Cells(8 + contador, 1).Value = "Tipo aceite"
        
        Sheets.Item("ETIQUETAS").Cells(3 + contador, 5).Value = "Serie"
        Sheets.Item("ETIQUETAS").Cells(4 + contador, 5).Value = "Laboratorio"
        Sheets.Item("ETIQUETAS").Cells(5 + contador, 5).Value = "Cambio de aceite"
        Sheets.Item("ETIQUETAS").Cells(6 + contador, 5).Value = "Responsable"
        
        'agrega los datos a la plantilla izquierda
        Sheets.Item("ETIQUETAS").Cells(1 + contador, 3).Value = faena
        Sheets.Item("ETIQUETAS").Cells(2 + contador, 3).Value = equipo
        Sheets.Item("ETIQUETAS").Cells(4 + contador, 3).Value = horo
        Sheets.Item("ETIQUETAS").Cells(5 + contador, 3).Value = fecha
        Sheets.Item("ETIQUETAS").Cells(6 + contador, 3).Value = modelo
        Sheets.Item("ETIQUETAS").Cells(7 + contador, 3).Value = icomponente
        Sheets.Item("ETIQUETAS").Cells(8 + contador, 3).Value = iaceite
        
        'agrega los datos a la plantilla derecha
        Sheets.Item("ETIQUETAS").Cells(3 + contador, 6).Value = serie
        Sheets.Item("ETIQUETAS").Cells(4 + contador, 6).Value = ilaboratorio
        Sheets.Item("ETIQUETAS").Cells(5 + contador, 6).Value = icambio
        Sheets.Item("ETIQUETAS").Cells(6 + contador, 6).Value = respo
        
        'Esta es la funcionan para sacar las horas de aceite
        horaaceite = buscarAceite(equipo, icomponente)
        Sheets.Item("ETIQUETAS").Cells(3 + contador, 3).Value = horaaceite
        
        rango1 = contador & "," & 1
        rango2 = (8 + contador) & "," & 7
        
        getRange rango1, rango2

        contador = contador + 12
    End If
Next i
End Sub

Public Function BuscaModelo(nequipo) As String 'Como su nombre lo dice. Busca el modelo del equipo y a su vez, genera un string concatenado para luego separarlos con un split.
Dim modelo As String, xequipo As String, conca As String
Dim i As Integer

For i = 2 To 2000
    xequipo = Sheets.Item("LM 20").Cells(i, 1).Value
    modelo = Sheets.Item("LM 20").Cells(i, 6).Value
    serie = Sheets.Item("LM 20").Cells(i, 9).Value
    faena = Sheets.Item("LM 20").Cells(i, 14).Value
    conca = modelo & "/" & faena & "/" & serie
    If (StrComp(xequipo, nequipo) = 0) Then
        BuscaModelo = conca
        Exit For
    End If
Next i

End Function

Public Function buscarAceite(equipo, componente) As String 'Esto realiza una busqueda de componentes en otra hoja. Para la comparacion se usa StrComp. En caso que una de las celdas de la columna A tenga vacio, se detiene el loop
Dim i As Integer
Dim xcomponente As String, xequipo As String

For i = 2 To 5000
    xequipo = Sheets.Item("HORAS ACEITE").Cells(i, 1).Value
    xcomponente = Sheets.Item("HORAS ACEITE").Cells(i, 4).Value
    
    If (equipo <> "") Then
        If ((StrComp(xequipo, equipo) = 0) And (StrComp(xcomponente, componente) = 0)) Then
            buscarAceite = Sheets.Item("HORAS ACEITE").Cells(i, 5).Value
        End If
    Else
        Exit For
    End If
Next i

End Function

Public Sub getRange(rango1, rango2) 'Se genera los rangos de una manera no muy de caballero pero, funciona. Obtengo los datos desde las celdas para generar un rango
Dim r1() As String, r2() As String
Dim rx10 As Integer, rx11 As Integer, rx20 As Integer, rx21 As Integer

r1 = Split(rango1, ",")
r2 = Split(rango2, ",")

rx10 = r1(0)
rx11 = r1(1)
rx20 = r2(0)
rx21 = r2(1)

rangox1 = Cells(rx10, rx11).Address(RowAbsolute:=False, ColumnAbsolute:=False)
rangox1IM = Cells(rx10, (rx11 + 6)).Address(RowAbsolute:=False, ColumnAbsolute:=False)
rangox2 = Cells(rx20, rx21).Address(RowAbsolute:=False, ColumnAbsolute:=False)

rango = rangox1 & ":" & rangox2
rangoImag = rangox1IM & ":" & rangox2
generarBordess rango
CopiaImagen rangoImag
End Sub

Sub CopiaImagen(rango) 'Copia la imagen de una hoja a otra en un rango especifico
    Worksheets("DATOS MANUALES").Shapes("Picture 1").Copy
    Worksheets("ETIQUETAS").Paste Worksheets("ETIQUETAS").range(rango)
End Sub

Public Sub generarBordess(rango) 'Genera los bordes con los rangos entregados en la funcion getRange
    Sheets.Item("ETIQUETAS").range(rango).Borders(xlEdgeLeft).LineStyle = xlContinuous
    Sheets.Item("ETIQUETAS").range(rango).Borders(xlEdgeTop).LineStyle = xlContinuous
    Sheets.Item("ETIQUETAS").range(rango).Borders(xlEdgeRight).LineStyle = xlContinuous
    Sheets.Item("ETIQUETAS").range(rango).Borders(xlEdgeBottom).LineStyle = xlContinuous
End Sub

Public Sub limpiar() 'Borra los datos para el rango entregado.
    Sheets.Item("ETIQUETAS").range("A1:CH1000").ClearContents
End Sub

Public Sub borrarImagen() 'Borra todas las imagenes que exisstan en la hoja establecida
Dim shape As Excel.shape

    For Each shape In Sheets.Item("ETIQUETAS").Shapes
        shape.Delete
    Next
End Sub

Public Sub limpiarBordes() 'Borra los bordes creados anteriormente.
    Sheets.Item("ETIQUETAS").range("A1:CH1000").Borders(Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlLineStyleNone
    Sheets.Item("ETIQUETAS").range("A1:CH1000").Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlLineStyleNone
    Sheets.Item("ETIQUETAS").range("A1:CH1000").Borders(Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlLineStyle.xlLineStyleNone
    Sheets.Item("ETIQUETAS").range("A1:CH1000").Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlLineStyleNone
    Sheets.Item("ETIQUETAS").range("A1:CH1000").Borders(Excel.XlBordersIndex.xlInsideHorizontal).LineStyle = Excel.XlLineStyle.xlLineStyleNone
    Sheets.Item("ETIQUETAS").range("A1:CH1000").Borders(Excel.XlBordersIndex.xlInsideVertical).LineStyle = Excel.XlLineStyle.xlLineStyleNone
End Sub

Al finalizar lo que tenemos es lo siguiente:


Los datos ingresados son los siguiente:



Al seleccionar distintos tipos de PM, es la cantidad de etiquetas que se generarán por cantidad de componentes.

Comentarios

Publicar un comentario

Entradas populares de este blog

Descarga revistas yumpu.com

Imagen
Como el titulo lo dice, generé un pequeño programa que realiza descargas de las revisar publicadas en yumpu.com. Necesitaba/n un archivo que había sido subido a este portal, el brillo es que se encuentra en un ember por lo que no se puede bajar o incluso siquiera revise si se podía. De igual manera, este es el código del programa por si alguien lo quiere mejorar o bajar imágenes desde otros lados y weas. Lo que hace el programa es bajar las imágenes de cada revisar que se encuentran en una ruta especifica. Para esto se debe entregar al programa el numero de la revista que se muestra en la imagenes N° 1. También se puede ver un JSON el cual nos presenta los tamaños de las imágenes y la cantidad de archivos. Una vez descargadas las imágenes, procedemos a transformar todo en un PDF y borrar las imágenes. El programa se realizo en C# con SharpDevelop en modo consola, las librerias itextSharp y NewtonSoft Json. De no ser libres estas librerías, besitos para que me perdonen de no ser a...
Leer más

Sorting Algorithm VBA

Necesitaba ordenar un valor en base a una lista de fechas ordenadas descendentes. No tenia idea como hacerlos y tampoco encontraba información al respecto. Cada vez que tengo una duda que ya no puedo solucionar, le pido ayuda a mi amigo Cristian Lizana para que me de una pista y encontrar el camino correcto. Me comentó de Sorting_algorithm  el cual respondía a mis necesidades. Implementé un código para analizar un rango que selecciono en Excel. Set rango = Application.InputBox(Prompt:="Seleccionar rango oe!!!", Title:="Seleccion de rango", Type:=8) 'Obtengo un rango seleccionado. x = 1 For i = 1 To rango.Rows.Count 'ingreso a un array todas las fechas seleccionadas. If (rango.Cells(i, 2).Value = componente) Then ReDim Preserve arrfech(x) arrfech(x) = CDate(rango.Cells(i, 1).Value) x = x + 1 End If Next i Sort ordena el array de fechas con el orden solicitado: Do Changed = False For Pointer = 1 To (Applica...
Leer más

BAT Windows ejecuta script PHP

En la publicación anterior , se presentó un código que me permite realizar backup desde dos bases de datos de motores diferentes, queda mostrar quien es el encargado de ejecutarlo. Lo podríamos hacer desde nuestro localhost, como servidor uso uniserver , pero por flojera prefiero que se ejecute cada vez que prendo el computados. Esto ultimo lo realizo con el inicio de Windows. ahora al punto que nos convoca. @echo off color 30 echo =================================================== echo = = echo = Transferencia de datos desde SQL Server ICPSAP = echo = = echo =================================================== echo. timeout 60 > NUL C:\UniServerZ\core\php54\php.exe "C:\UniServerZ\www\Panel\script.php" pause exit El código esta en BAT. Voy a explicar solo lo básico (o sea todo el código ya que es ultra básico) @echo off: Desactiva volvamiento de texto. color ...
Leer más