' Desarrollado por Adal Pérez
' Copia para evaluación. Leer LEEME.txt antes de ejecutar.
' Código de cálculo sin cambios; limpieza limitada a comentarios.

Option Explicit

Sub Integrar_Hojas_En_Generador_V5()

    Dim ws As Worksheet
    Dim wsGen As Worksheet
    Dim ultimaFila As Long
    Dim ultimaCol As Long
    Dim filaDestino As Long
    Dim rangoCopiar As Range
    Dim rangoDestino As Range
    Dim rangoImpresion As Range
    Dim shp As Shape
    Dim nuevaShp As Shape
    Dim filasCopiadas As Long
    Dim columnasCopiadas As Long
    Dim i As Long
    Dim col As Long
    Dim oldCopyObjects As Boolean
    Dim ultimaFilaCopiada As Long
    Dim ultimaColCopiada As Long

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Set wsGen = ThisWorkbook.Worksheets("GENERADOR")

    ' Asegurar que GENERADOR y CATÁLOGO estén visibles antes de trabajar
    ThisWorkbook.Worksheets("GENERADOR").Visible = xlSheetVisible
    ThisWorkbook.Worksheets("CATÁLOGO").Visible = xlSheetVisible

    ' Guarda configuración actual de Excel respecto a copiar objetos con celdas
    oldCopyObjects = Application.CopyObjectsWithCells

    ' MUY IMPORTANTE:
    ' Evita que Excel copie imágenes automáticamente al copiar el rango,
    ' porque después las copiamos manualmente con tamaño y posición exacta.
    Application.CopyObjectsWithCells = False

    ' Limpia GENERADOR desde fila 11 hacia abajo
    wsGen.Rows("11:" & wsGen.Rows.Count).Clear

    ' Borra imágenes/objetos previos desde fila 11 hacia abajo en GENERADOR
    For i = wsGen.Shapes.Count To 1 Step -1
        If wsGen.Shapes(i).TopLeftCell.Row >= 11 Then
            wsGen.Shapes(i).Delete
        End If
    Next i

    ' Limpia área de impresión previa
    wsGen.PageSetup.PrintArea = ""

    filaDestino = 11
    ultimaFilaCopiada = 10
    ultimaColCopiada = 1

    For Each ws In ThisWorkbook.Worksheets

        If UCase(ws.Name) <> "CATÁLOGO" And UCase(ws.Name) <> "GENERADOR" Then

            ' Si alguna hoja está oculta, se hace visible temporalmente para poder copiar bien
            ws.Visible = xlSheetVisible

            ultimaFila = UltimaFilaConContenidoIncluyendoImagenes(ws)
            ultimaCol = UltimaColumnaConContenido(ws)

            If ultimaFila >= 11 And ultimaCol >= 1 Then

                Set rangoCopiar = ws.Range(ws.Cells(11, 1), ws.Cells(ultimaFila, ultimaCol))

                filasCopiadas = rangoCopiar.Rows.Count
                columnasCopiadas = rangoCopiar.Columns.Count

                Set rangoDestino = wsGen.Cells(filaDestino, 1).Resize(filasCopiadas, columnasCopiadas)

                ' ============================================================
                ' CAMBIO CLAVE V5:
                ' 1) Copia formatos, bordes, colores, alineaciones, etc.
                ' 2) Después pega SOLO VALORES para evitar que las fórmulas se recalculen como cero.
                ' ============================================================

                rangoCopiar.Copy

                ' Pegar formatos completos
                rangoDestino.PasteSpecial Paste:=xlPasteFormats

                ' Pegar validaciones / comentarios si existieran
                On Error Resume Next
                rangoDestino.PasteSpecial Paste:=xlPasteValidation
                rangoDestino.PasteSpecial Paste:=xlPasteComments
                On Error GoTo 0

                Application.CutCopyMode = False

                ' Pegar valores directamente, NO fórmulas
                rangoDestino.Value = rangoCopiar.Value

                ' Copiar anchos de columna usados
                For col = 1 To ultimaCol
                    wsGen.Columns(col).ColumnWidth = ws.Columns(col).ColumnWidth
                Next col

                ' Copiar alturas de fila, esto es clave para que las imágenes no se encimen
                For i = 0 To filasCopiadas - 1
                    wsGen.Rows(filaDestino + i).RowHeight = ws.Rows(11 + i).RowHeight
                Next i

                ' Copiar imágenes/objetos manualmente, conservando tamaño y posición
                For Each shp In ws.Shapes

                    If ShapeDentroDelRango(shp, rangoCopiar) Then

                        shp.Copy
                        wsGen.Paste

                        Set nuevaShp = wsGen.Shapes(wsGen.Shapes.Count)

                        With nuevaShp
                            .LockAspectRatio = shp.LockAspectRatio
                            .Placement = xlMoveAndSize

                            ' Primero tamaño exacto
                            .Width = shp.Width
                            .Height = shp.Height

                            ' Luego posición relativa exacta respecto al rango copiado
                            .Left = wsGen.Cells(filaDestino, 1).Left + (shp.Left - rangoCopiar.Left)
                            .Top = wsGen.Cells(filaDestino, 1).Top + (shp.Top - rangoCopiar.Top)
                        End With

                    End If

                Next shp

                ' Actualizar límites copiados para el área de impresión
                If filaDestino + filasCopiadas - 1 > ultimaFilaCopiada Then
                    ultimaFilaCopiada = filaDestino + filasCopiadas - 1
                End If

                If ultimaCol > ultimaColCopiada Then
                    ultimaColCopiada = ultimaCol
                End If

                ' Dejar una fila en blanco entre hojas
                filaDestino = filaDestino + filasCopiadas + 1

            End If

        End If

    Next ws

    ' Ampliar área de impresión hasta lo último copiado.
    ' Se toma desde A1 para conservar encabezados/formato superior de GENERADOR.
    If ultimaFilaCopiada >= 11 Then
        Set rangoImpresion = wsGen.Range(wsGen.Cells(1, 1), wsGen.Cells(ultimaFilaCopiada, ultimaColCopiada))
        wsGen.PageSetup.PrintArea = rangoImpresion.Address
    End If

    ' Ocultar todas las hojas excepto CATÁLOGO y GENERADOR
    For Each ws In ThisWorkbook.Worksheets
        If UCase(ws.Name) = "CATÁLOGO" Or UCase(ws.Name) = "GENERADOR" Then
            ws.Visible = xlSheetVisible
        Else
            ws.Visible = xlSheetHidden
        End If
    Next ws

    ' Dejar activa la hoja GENERADOR
    wsGen.Activate

Salida:
    ' Restaurar configuración original
    Application.CopyObjectsWithCells = oldCopyObjects

    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    MsgBox "Listo. Se integraron las hojas en GENERADOR usando valores, se actualizó el área de impresión y se ocultaron las demás hojas.", vbInformation

End Sub


Function UltimaFilaConContenidoIncluyendoImagenes(ws As Worksheet) As Long

    Dim ultimaCelda As Range
    Dim shp As Shape
    Dim ultimaFila As Long

    ultimaFila = 0

    Set ultimaCelda = ws.Cells.Find(What:="*", _
                                   After:=ws.Range("A1"), _
                                   LookAt:=xlPart, _
                                   LookIn:=xlFormulas, _
                                   SearchOrder:=xlByRows, _
                                   SearchDirection:=xlPrevious, _
                                   MatchCase:=False)

    If Not ultimaCelda Is Nothing Then
        ultimaFila = ultimaCelda.Row
    End If

    ' Considerar también imágenes/objetos:
    ' usa BottomRightCell para no cortar imágenes grandes que empiezan arriba pero terminan abajo.
    For Each shp In ws.Shapes
        If shp.BottomRightCell.Row > ultimaFila Then
            ultimaFila = shp.BottomRightCell.Row
        End If
    Next shp

    UltimaFilaConContenidoIncluyendoImagenes = ultimaFila

End Function


Function UltimaColumnaConContenido(ws As Worksheet) As Long

    Dim ultimaCelda As Range
    Dim shp As Shape
    Dim ultimaCol As Long

    ultimaCol = 0

    Set ultimaCelda = ws.Cells.Find(What:="*", _
                                   After:=ws.Range("A1"), _
                                   LookAt:=xlPart, _
                                   LookIn:=xlFormulas, _
                                   SearchOrder:=xlByColumns, _
                                   SearchDirection:=xlPrevious, _
                                   MatchCase:=False)

    If Not ultimaCelda Is Nothing Then
        ultimaCol = ultimaCelda.Column
    End If

    ' Considerar también imágenes/objetos que lleguen a columnas más a la derecha
    For Each shp In ws.Shapes
        If shp.BottomRightCell.Column > ultimaCol Then
            ultimaCol = shp.BottomRightCell.Column
        End If
    Next shp

    If ultimaCol = 0 Then ultimaCol = 1

    UltimaColumnaConContenido = ultimaCol

End Function


Function ShapeDentroDelRango(shp As Shape, rng As Range) As Boolean

    Dim r1 As Long, r2 As Long
    Dim c1 As Long, c2 As Long

    r1 = rng.Row
    r2 = rng.Row + rng.Rows.Count - 1
    c1 = rng.Column
    c2 = rng.Column + rng.Columns.Count - 1

    ' Detecta si la imagen/objeto toca el rango,
    ' no solo si empieza dentro del rango.
    ShapeDentroDelRango = Not ( _
        shp.BottomRightCell.Row < r1 Or _
        shp.TopLeftCell.Row > r2 Or _
        shp.BottomRightCell.Column < c1 Or _
        shp.TopLeftCell.Column > c2 _
    )

End Function
