Jump to content

SALAVERRINO

Members
  • Content Count

    301
  • Joined

  • Last visited

Posts posted by SALAVERRINO

  1. Buenos días a los integrantes del foro, en esta ocasión recurro a uds, para que me brinden su apoyo con la siguiente macro, el cual me esta emitiendo un error en la segunda macro con el titulo Macro que permite grabar hoja en un nuevo libro,  y es que al momento de guardar los datos de la hoja REPORTE a la hoja PRE_REPORTE  y cuyo dato de la hoja REPORTE celda C3 no convierte como #¡VALOR! tras presionar SI, para lo cual anexo archivo y desde ya agradezco su atención y apoyo.

    image.png.b8aa8369ca48a49331811fbdbb2bfbe6.png

    image.thumb.png.51b3660dd685828b3ca6f5f3ea3de119.png

    Macro que copiar de una hoja a otra hoja:

    Sub CopiarReporte()
        Application.ScreenUpdating = False
            Set h1 = Sheets("REPORTE")
            Set h2 = Sheets("PRE_REPORTE")
            h2.Cells.Clear
            h1.Cells.Copy
            h2.Range("A1").PasteSpecial Paste:=xlPasteValues
            h2.Range("A1").PasteSpecial Paste:=xlPasteFormats
        Range("A1").Select
        Application.ScreenUpdating = True
    End Sub

    Macro que permite grabar hoja en un nuevo libro:

    Sub copiar_reportes()
    Dim nom$, fech$, hor$, fich$, nomb2$
    
    Application.ScreenUpdating = False
    
    nomb2 = Sheets("REPORTE").Cells(1, "a")
    nom = Sheets("REPORTE").Cells(1, "b")
    
    fech = Format(Date, "dd-mm-yy")
    hor = Format(Time, "hh-mm-ss")
    
    fich = ThisWorkbook.Path & "\" & "02 FILTRO DE REPORTES " & nom & " PTO SALAVERRY " & nomb2 & " " & fech & "_" & hor & " HRS" & ".xlsx"
    
    Sheets("PRE_REPORTE").Copy
    ActiveWorkbook.SaveAs (fich)
    ActiveWorkbook.Close
    Range("A1").Select
    Application.ScreenUpdating = True
    End Sub

    https://drive.google.com/file/d/1xzz46-ulCbnyyjKGbZAdkxiI4bAzeAjt/view?usp=sharing

    Saludos.

  2. Buenas tardes a los integrantes de este foro, en esta ocasión recurro a Uds, para que me brinden su ayuda en como se puede mostrar el resultado de la pestaña PLANILLA los valores que están en la celdas I3 y J3, para lo cual describo su procedimiento:

    *Al presionar el botón MENU nos envía al formulario Cálculos de las Jornadas (Userform9) y tras presionar realiza los cálculos que contiene la pestaña PLANILLA y genera los resultados que se encuentran en la celda I3 y J3 y hasta el momento he podido lograr que el resultado se muestre digitando el valor cero (0) en cada TextBox para visualizar el resultado o saliendo del formulario y volviendo a ejecutarlo para obtener la visualización del resultado (Userform9)  y lo que quisiera es que dichos valores se muestren automáticamente tras terminar el procedimiento y mostrar el mensaje SE ACTUALIZO CÁLCULOS en los TextBox1 y TextBox2 o presionar doble click.

    '*************************************************************************************
    '*************************************************************************************
    'AQUI SE DISPLAYA LOS TEXTBOX PARA QUE MUESTE EL RESULTADO DE LA PESTAÑA PLANILLA
    Private Sub TextBox1_Change()
    On Error Resume Next
    Application.ScreenUpdating = False
        UserForm9.TextBox1.Text = Format(Sheets("PLANILLA").Range("I3").Value, "#,###,###0.00")
    Application.ScreenUpdating = True
    End Sub
    Private Sub TextBox2_Change()
    On Error Resume Next
    Application.ScreenUpdating = False
        UserForm9.TextBox2.Text = Format(Sheets("PLANILLA").Range("J3").Value, "#,###,###0.00")
    Application.ScreenUpdating = True
    End Sub
    Private Sub TextBox1_2()
    Application.ScreenUpdating = False
    TextBox1.Text = ""
    TextBox2.Text = ""
    DoEvents
    Application.ScreenUpdating = True
    End Sub
    Private Sub UserForm_Initialize()
        UserForm9.TextBox1.Text = Format(Sheets("PLANILLA").Range("I3").Value, "#,###,###0.00")
        UserForm9.TextBox2.Text = Format(Sheets("PLANILLA").Range("J3").Value, "#,###,###0.00")
    End Sub

    Desde ya agradezco la atención que le brinde, adjunto link:

    https://drive.google.com/file/d/1JRo1j0XdamuKZb8TTUJP5T6r5OLT5fq-/view?usp=sharing

    NOTA: El archivo para ejecutar es SISTEMA DE CALCULOS PLANILLAJE ILO.xlsm

  3. Buenos días  @Luis paz, gracias por el aporte brindado, el cual se soluciono, la primera opción de no aparecer la carpeta para guardar los PDF, sin embargo cuando comienza a imprimir los PDF de 1 en 1, se genera 1 solo archivo, pero solo esta guardando el ultimo registro asignado con el numero 98, pero los primeros registros no se muestran.

    Saludos y espero comentarios.

    99 Boletas.pdf

  4. Buenas días a los integrantes de esté prestigioso Foro, en esta ocasión recurro a Uds para que me brinde su apoyo al guardar los archivos PDF, la siguiente macro lo encontré en un vídeo de youtube de ExceleInfo, el cual lo adapte a mi requerimiento, pero tengo algunos inconvenientes:

    Macro original:

    Option Explicit
    
    Sub ElegirAccion()
    Dim Elegir As Variant
    Dim i As Integer
    Dim miArchivo As String
    Dim a As String
    Dim Ruta As String
    Dim intInicial As Integer
    Dim intFinal As Integer
    Dim intConsecutivo As Integer
    Dim srtTitulo As String
    
    srtTitulo = "EXCELeINFO"
    intConsecutivo = ThisWorkbook.Sheets("Datos").Range("CONSECUTIVO").Value
    
    Elegir = InputBox("Elige la acción a ejecutar:" & vbNewLine & "1 = Imprimir" & _
    vbNewLine & "2 = Guardar en PDF", srtTitulo)
    
    If Elegir <> 1 And Elegir <> 2 Then
        MsgBox "Debe elegir una opción correcta.", vbExclamation, srtTitulo
    ElseIf Elegir = 1 Then
        
        intInicial = InputBox("Introduce el ID inicial", srtTitulo)
        intFinal = InputBox("Introduce el ID final", srtTitulo)
        
        If intFinal < intInicial Or intFinal > intConsecutivo Then
            MsgBox "Valida el ID final.", vbExclamation, srtTitulo
        Else
            For i = intInicial To intFinal
                
                ThisWorkbook.Sheets("Imprimir").Range("F4").Value = i
                MsgBox "Imprimiendo ID '" & i & "'. Presione Aceptar para continuar...", vbInformation, srtTitulo
                'ThisWorkbook.ActiveSheet.PrintOut Copies:=1
                
            Next i
        End If
        
    ElseIf Elegir = 2 Then
        
        intInicial = InputBox("Introduce el ID inicial", srtTitulo)
        intFinal = InputBox("Introduce el ID final", srtTitulo)
        
        If intFinal < intInicial Or intFinal > intConsecutivo Then
            MsgBox "Valida el ID final.", vbExclamation, srtTitulo
        Else
            'Propiedad FileDialog
            With Application.FileDialog(msoFileDialogFolderPicker)
                .InitialFileName = ActiveWorkbook.Path & " \ "
                .Title = "EXCELeINFO - Seleccionar carpeta"
                .Show
                If .SelectedItems.Count = 0 Then
                Else
                    Ruta = .SelectedItems(1)
                    For i = intInicial To intFinal
                        
                        ThisWorkbook.Sheets("Imprimir").Range("F4").Value = i
                        
                        MsgBox "Guardando en PDF ID '" & i & "'. Presione Aceptar para continuar...", _
                        vbInformation, srtTitulo
                        
                        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                        Ruta & "\" & i & ".pdf", Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                        
                    Next i
                End If
            End With
        End If
    End If
        
    End Sub

    Macro modificada:

    Option Explicit
    Sub ElegirAccion()
    Dim i As Integer
    Dim intInicial As Integer
    Dim intFinal As Integer
    Dim intConsecutivo As Integer
    Dim srtTitulo As String
    Dim Ruta As String
    
    srtTitulo = "PRUEBITA"
    intConsecutivo = ThisWorkbook.Sheets("BOLETA PDF").Range("CONSECUTIVO").Value
    
        intInicial = Sheets("BOLETA PDF").Range("N4")
        intFinal = Sheets("BOLETA PDF").Range("M3")
        
        If intFinal < intInicial Or intFinal > intConsecutivo Then
            MsgBox "Valida el ID final.", vbExclamation, srtTitulo
        Else
            With Application.FileDialog(msoFileDialogFolderPicker)
                .InitialFileName = ActiveWorkbook.Path & " \ "
                .Title = "EXCELeINFO - Seleccionar carpeta"
                .Show
                If .SelectedItems.Count = 0 Then
                Else
                    Ruta = .SelectedItems(1)
                    For i = intInicial To intFinal
                        
                        ThisWorkbook.Sheets("BOLETA PDF").Range("B5").Value = i
                        
                        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "\" & i & " " & Sheets("BOLETA PDF").Range("I6") & ".pdf", _
                        Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                   Next i
                End If
            End With
        End If
    End Sub

     

    *Al estas en la pestaña BOLETAS PDF y al presionar el botón IMPRIMIR PDF me muestra la carpeta donde se guardara los datos pdf, y lo que quiera es que guarde los pdf sin necesidad que mencione y muestre la carpeta a guardar.

    *Luego que se muestra la dirección a guardar los pdf, empiezan a generarse 1 x 1 cada ID (en esta ocasión son 98 registros de los cuales pueden ser más o menos) y lo que requiero es que se guarde en 1 solo archivos los 98 registros.

    *También si fuera posible mediante otra macro, en lugar de ir guardando por el ID los 98 registros sea con nombres y apellidos, que se ubican en la celda O4 (opcional).

    Adjunto link del archivo: https://drive.google.com/file/d/1ABlsmnrhXwBjLeLwYuTSi0_b1N_qWrqD/view?usp=sharing 

    Desde ya agradezco tu apoyo.

    Saludos.

  5. Buenas tardes a los integrantes del foro, en esta ocasión recurro a uds, para que brinde su apoyo en como unificar la formula siguiente

    1º formula: REDONDEAR(SI(Y(A3<>"WEJ1";A3<>"WEJ2";A3<>"WEJ3");0;SI(B3>1000;C3*15%;0));2),

    2º formula: REDONDEAR(SI(Y(A3<>"MEJ1";A3<>"MEJ2";A3<>"MEJ3");0;SI(B3>1000;C3*8%;0));2)

    ya que actualmente la trabajo 2 celdas y luego sumo ambos resultados, como se aprecia en el siguiente archivo que adjunto, desde ya agradezco su apoyo y colaboración.

    Saludos.

     

    UNIFICAR FORMULA.xlsx

  6. Buenos dias a los integrantes de este prestigioso foro, en esta ocasión recurro a uds., para que me brinde su apoyo en cómo realizar el cambio automático del valor año de una determina fecha y que el cambio sea sobre la misma celda, es decir si tengo un valor en la celda B2 (01-01-18) se convierta automáticamente en (01-01-19) y así sucesivamente como se aprecia el resultado en la celda C2 y D2 para el próximo año, ya que por el momento tengo que estar reemplazando el valor del año, adjunto archivo para mejor detalle y esto es con el fin de realizar el cálculo de feriados.

    Desde ya agradezco su atención por el apoyo.

    AYUDA CON FORMULA FECHA.xlsx

×
×
  • Create New...

Important Information

Privacy Policy