Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Seleccionar Checkbox para toma de decisiones

crengifo

Por crengifo
en Macros y programación VBA

 Share

Recommended Posts

crengifo Aprendiz

crengifo

publicado
publicado

Buenas tardes estimados, tengo la siguiente macro donde quiero que al seleccionar el checkbox1 me ejecute el primer procedimiento de lo contario siga al siguiente procedimiento, pero me esta tomando el valor en la casilla de adicion del segundo procedimiento. Agradezco me puedan orientar gracias.

Captura.JPG.3bb515bb80c73b1e5ea83fbeeb003f35.JPG 

Sub Dedicion()
dim sh1, jh2, jh3, jh4, jh5, jh6 as Worksheet
If sh1.CheckBox1.Value = True Then
    
    Set jh5 = Workbooks.Open("\\10.7.10.1\calidad\RegCalidad 2024\Molienda de Cemento y Empaque\Base datos Cementos producido 2024.xlsx", ReadOnly:=True)
    Set jh6 = Sheets("MEZCLA ADICION")
    
    jh6.Activate
    jh6.Cells(4, "A").Select
    JFila = ActiveCell.Row
    
    For i = 371 To 736
        
        JFila = jh6.Cells(JFila, "A").End(xlDown).Row
    
    Next i
    
        JFila = Cells(JFila, "K").End(xlUp).Row
          
        Cal5 = jh6.Cells(JFila, "K")

    Else
    Set jh1 = Workbooks.Open("\\10.7.10.1\calidad\SEGUIMIENTO HORA-HORA\PREHOMO.xlsx", ReadOnly:=True)
    Set jh2 = Sheets("CALIZA ADICIÓN CTO")
    
    jh2.Activate
    jh2.Cells(4, "A").Select
    JFila = ActiveCell.Row
    
    For i = 1 To 4
        
        JFila = jh2.Cells(JFila, "A").End(xlDown).Row
                
    Next i
    
    JFila = Cells(JFila, "K").End(xlUp).Row
    
    End If
    
    If jh2.Cells(JFila, "K") < jh2.Cells(JFila - 1, "K") Then
        
        Cal1 = jh2.Cells(JFila, "K")
        
        Else
            
            Cal1 = (jh2.Cells(JFila, "K") + jh2.Cells(JFila - 1, "K")) / 2
        
    End If
    
    Set jh3 = Workbooks.Open("\\10.7.10.1\calidad\RegCalidad 2024\Molienda de Cemento y Empaque\Base datos Cementos producido 2024.xlsx", ReadOnly:=True)
    Set jh4 = Sheets("CALIZA ADICION")
    
    For i = 371 To 736
   
        If (Not (jh4.Cells(i, "K") = Empty)) And jh4.Cells(i, "A") = (fecha - 1) And jh4.Cells(i, "B") = "4" Then
            
            Cal2 = jh4.Cells(i, "K")
            
            
            Else
            
                If Cal2 < 2 Or Cal2 > 59 Then
                    
                    Cal2 = 60
                    
                End If
                    
        End If
   
    Next i
    
    Filacal = jh4.Cells(736, "K").End(xlUp).Row
    Cal3 = jh4.Cells(Filacal, "K")
    
    If Cal2 = 60 Then
        
        Cal4 = Cal3
        
        Else
        
        Cal4 = Cal2
    
    End If
    
    
    jh4.Activate
    ActiveWorkbook.Close
   
    If Cal1 < Cal4 Then
        
        Caliza = Cal1
        
        Else
            
            Caliza = Cal4
            
    End If
    
    sh1.Activate
    sh1.Cells(1, "N") = Caliza
    
    jh2.Activate
    ActiveWorkbook.Close
    
    Application.ScreenUpdating = True
      
End Sub

 

Cemento.xlsm Cemento.zip

Héctor Miguel Gran colaborador

Héctor Miguel

publicado
publicado
hace 6 horas, crengifo dijo:

quiero que al seleccionar el checkbox1 me ejecute el primer procedimiento de lo contario siga al siguiente procedimiento, pero me esta tomando el valor en la casilla de adicion del segundo procedimiento

lo mismo que te sugeri 'alla'...

te dejo tres observaciones 'esencialmente basicas' que estas omitiendo en el codigo que expones:

1ª vba NO es (como) vb 'stand-alone', vba requiere asignar el tipo a cada variable declarada (por lo tanto)...
- de tu primera instruccion: 

  Dim sh1, jh2, jh3, jh4, jh5, jh6 As Worksheet

SOLO la ultima variable (jh6) es de tipo 'worksheet', las demas 'asumen' Variant (por omision)

2ª a la primera variable (sh1) tampoco le asignaste una referencia
- ANTES de la instruccion: 

  If sh1.CheckBox1.Value = True Then

DEBES vincular el 'checkbox' con 'su hoja' (que asumo es...) la hoja activa del libro activo ?
- agrega una instruccion ± asi: 

  Set sh1 = ActiveSheet

3ª tienes otras variables NO asignadas (y alguna/s del tipo incorrecto)

por el resto... la pelota se queda en tu cancha (es un codigo muy 'saltimbanqui') ?

crengifo Aprendiz

crengifo

publicado
  • Autor
publicado

Buenos dias gracias por responder, te adjunto el codigo que tiene actualmente la hoja y que trabaja sin problemas. El detalle es que no se tomo en cuenta otra variable y es la que quiero introducior con el CheckBox y es lo que quiero que me ayuden a engranar. O si es posible mejorarlo. Muchas gracias por su apoyo

Sub Pignea()
Dim jh1, jh3 as Workbook
Dim sh1, jh1, jh2, jh3, jh4 as Worksheet

Set jh1 = Workbooks.Open("\\10.7.10.1\calidad\SEGUIMIENTO HORA-HORA\PREHOMO.xlsx", ReadOnly:=True)
Set jh2 = Sheets("CALIZA ADICIÓN CTO")

jh2.Activate
jh2.Cells(4, "A").Select
JFila = ActiveCell.Row

For i = 1 To 4

JFila = jh2.Cells(JFila, "A").End(xlDown).Row

Next i

JFila = Cells(JFila, "K").End(xlUp).Row

End If

If jh2.Cells(JFila, "K") < jh2.Cells(JFila - 1, "K") Then

Cal1 = jh2.Cells(JFila, "K")

Else

Cal1 = (jh2.Cells(JFila, "K") + jh2.Cells(JFila - 1, "K")) / 2

End If

Set jh3 = Workbooks.Open("\\10.7.10.1\calidad\RegCalidad 2024\Molienda de Cemento y Empaque\Base datos Cementos producido 2024.xlsx", ReadOnly:=True)
Set jh4 = Sheets("CALIZA ADICION")

For i = 371 To 736

If (Not (jh4.Cells(i, "K") = Empty)) And jh4.Cells(i, "A") = (fecha - 1) And jh4.Cells(i, "B") = "4" Then

Cal2 = jh4.Cells(i, "K")

Else

If Cal2 < 2 Or Cal2 > 59 Then

Cal2 = 60

End If

End If

Next i

Filacal = jh4.Cells(736, "K").End(xlUp).Row
Cal3 = jh4.Cells(Filacal, "K")

If Cal2 = 60 Then

Cal4 = Cal3

Else

Cal4 = Cal2

End If

jh4.Activate
ActiveWorkbook.Close

If Cal1 < Cal4 Then

Caliza = Cal1

Else

Caliza = Cal4

End If

sh1.Activate
sh1.Cells(1, "N") = Caliza

jh2.Activate
ActiveWorkbook.Close

crengifo Aprendiz

crengifo

publicado
  • Autor
publicado

La macro lo que pretende es hacer lo siguiente:
En primera instancia no tenia el checkbox por lo tanto la macro estaba realizando su trabajo en cual consiste en los siguiente.
Revisa la columna K de la hoja CALIZA ADICIÓN CTO y compara los dos últimos datos, si el ultimo dato es mayor que el anterior los suma y los divide entre 2, ahora si el ultimo dato es menor toma ese dato. Luego verifica la columna K de la hoja CALIZA ADICION, si el ultimo valor es menor que el obtenido en la fase anterior toma este nuevo valor sino deja el valor anterior.
Resulta que no se tomo en cuenta la mezcla de materia prima. Entonces se me ocurrió usar un select que cuando utilicemos la mezcla haga otro procedimiento sino hago el procedimiento ya mencionado y es aquí donde me enrede. Espero haberme explicado.
Ahora si de alguna manera se puede mejorar lo que tengo se los agradecería.

crengifo Aprendiz

crengifo

publicado
  • Autor
publicado

Buenas tardes compañero tengo los siguiente, me esta resultado pero no me esta extrayendo el ultimo valor de la columna K del rango especificado, me podrían ayudar creo que es por que tiene celdas vacias dentro del rango especificado. Como solucionaría este impase agradezco sus comentarios.

Sub extraer()
Dim jh5 As Workbook
Dim sh1, jh6 As Worksheet
Dim ndatos, uvalor As Double

Application.ScreenUpdating = False

    Set sh1 = ThisWorkbook.Sheets("Hoja1")

    If sh1.Cells(1, "L").Value = "Mezcla" Then
        
    Set jh5 = Workbooks.Open("\\10.7.10.1\calidad\RegCalidad 2024\Molienda de Cemento y Empaque\Base datos Cementos producido 2024.xlsx", ReadOnly:=True)
    Set jh6 = Sheets("MEZCLA ADICION")

    ndatos = Application.WorksheetFunction.Count(jh6.Range("K371:K736"))
    uvalor = Application.WorksheetFunction.Index(jh6.Range("K371:K736"), ndatos)
    sh1.Cells(1, "N") = uvalor
    
    jh6.Activate
    ActiveWorkbook.Close
    
    Else
      
    'Call calizaco
    
    End If
  
    Application.ScreenUpdating = True
End Sub
 

Héctor Miguel Gran colaborador

Héctor Miguel

publicado
publicado
hace 9 horas, crengifo dijo:

si es posible mejorarlo

(creo que) no estas contando 'toda la historia' (y te haces trampas tu solo), me explico:

(de tu codigo inicial) del libro 'base ... producido.xlsx'

1) cuando consultas la hoja 'mezcla adicion'
- que uso das a (o para que sirve) la variable 'Cal5' ???
- solo le asignas un valor pero jamas vuelve a aparecer en el codigo

2) cuando consultas la hoja 'caliza adicion'
- por que recorres las filas 371 a 736 (son 366 ciclos -probablemente- innecesarios) ???
- de donde se 'construye' la variable 'fecha' para comparar la columna "A" ???
- hay alguna situacion especial para evaluar SOLO el 'molino 4' ???

3) por que tanto 'switcheo' entre las variables 'Cal1 a Cal5' para determinar 'caliza' ???

si tienes mas 'detalles en el tintero' ? (es buen momento para comentarlos -todos ?-)

sugerencia:
decide en cual foro quieres continuar esta consulta
o pon un link en cada foro a tu consulta en el otro

Conéctate para comentar

Podrás dejar un comentario después de conectarte



Conéctate ahora
 Share
Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • DiegoPC
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por DiegoPC · publicado

      Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.