Macro per copiare foglio con aiuto di Chat GPT

Creare una macro - Scrivere uno script - Usare le API
Rispondi
amax
Messaggi: 100
Iscritto il: mercoledì 7 novembre 2012, 10:59

Macro per copiare foglio con aiuto di Chat GPT

Messaggio da amax »

ciao a tutti ho preso una mia vecchia macro e l'ho data in pasto a Chat GPT per migliorare alcune cose.
Praticamente voglio copiare un foglio che contiene formule, immagini ecc in un foglio con solo valori e fin qui tutto bene.
Vorrei aggiungere alla macro la possibilità di copiare le celle unite come tali e non come celle singole e vorrei copiare anche i grafici. Questi due passaggi non sono riuscito ad aggiungere, molto probabilmente non sono stato in grado di fornire il prompt giusto.
allego la macro.
Naturalmente io sono partito da una macro molto più piccola e semplice, quelle che allego sono il risultato di un giorno di lavoro con chat GPT

questa è quella che funziona senza forzare la copia delle celle e dei grafici

Codice: Seleziona tutto

Sub CopiaValoriTestoConFormattazioneDaFoglioDinamico()

    ' Dichiarazione delle variabili
    Dim oDocument As Object
    Dim oSheetDati As Object
    Dim oSheetNuovo As Object
    Dim oCellaNomeOrigine As Object
    Dim oCellaNomeDestinazione As Object
    Dim nomeFoglioOrigine As String
    Dim nomeFoglioDestinazione As String
    Dim rangeDati As Object
    Dim sourceCell As Object
    Dim targetCell As Object
    Dim i As Integer
    Dim j As Integer
    Dim oShape As Object
    Dim targetPage As Object
    Dim oDrawPage As Object

    ' Ottieni il documento attivo (il file Calc aperto)
    oDocument = ThisComponent

    ' Ottieni il foglio attivo da cui prendere il nome del foglio di origine
    oSheetDati = oDocument.CurrentController.ActiveSheet

    ' Ottieni il nome del foglio di origine dalla cella O1
    oCellaNomeOrigine = oSheetDati.getCellRangeByName("O1")
    nomeFoglioOrigine = oCellaNomeOrigine.getString()

    ' Ottieni il nome del foglio di destinazione dalla cella F1
    oCellaNomeDestinazione = oSheetDati.getCellRangeByName("F1")
    nomeFoglioDestinazione = oCellaNomeDestinazione.getString()

    ' Controlla se il foglio di origine esiste
    On Error GoTo FoglioOrigineNonTrovato
    oSheetDati = oDocument.Sheets.getByName(nomeFoglioOrigine)

    ' Controlla se il foglio con lo stesso nome esiste già
    On Error GoTo CreaFoglio
    oSheetNuovo = oDocument.Sheets.getByName(nomeFoglioDestinazione)
    MsgBox "Un foglio con questo nome esiste già!"
    Exit Sub

FoglioOrigineNonTrovato:
    MsgBox "Il foglio di origine " & nomeFoglioOrigine & " non esiste."
    Exit Sub

CreaFoglio:
    ' Crea un nuovo foglio con il nome specificato
    oDocument.Sheets.insertNewByName(nomeFoglioDestinazione, oDocument.Sheets.getCount())
    oSheetNuovo = oDocument.Sheets.getByName(nomeFoglioDestinazione)

    ' Copia le dimensioni delle colonne e delle righe
    For i = 0 To 7 ' Per le colonne da A a H
        oSheetNuovo.Columns(i).Width = oSheetDati.Columns(i).Width
    Next i

    For i = 0 To 104 ' Per le righe da 1 a 105
        oSheetNuovo.Rows(i).Height = oSheetDati.Rows(i).Height
    Next i

    ' Specifica il range dei dati da copiare (celle da A1 a H105)
    rangeDati = oSheetDati.getCellRangeByName("A1:H105")

    ' Passa a copiare contenuti e formattazione
    For i = 0 To rangeDati.Rows.getCount() - 1
        For j = 0 To rangeDati.Columns.getCount() - 1
            sourceCell = rangeDati.getCellByPosition(j, i)
            targetCell = oSheetNuovo.getCellByPosition(j, i)

            ' Copia il contenuto della cella (valori, testo, formula)
            If sourceCell.Type = com.sun.star.table.CellContentType.EMPTY Then
                targetCell.clearContents(1023)
            ElseIf sourceCell.Type = com.sun.star.table.CellContentType.VALUE Then
                targetCell.Value = sourceCell.Value
            ElseIf sourceCell.Type = com.sun.star.table.CellContentType.TEXT Then
                targetCell.String = sourceCell.String
            ElseIf sourceCell.Type = com.sun.star.table.CellContentType.FORMULA Then
                If sourceCell.FormulaResultType = com.sun.star.table.CellContentType.TEXT Then
                    targetCell.String = sourceCell.String
                ElseIf sourceCell.FormulaResultType = com.sun.star.table.CellContentType.VALUE Then
                    If sourceCell.Value = 0 Then
                        targetCell.clearContents(1023)
                    Else
                        targetCell.Value = sourceCell.Value
                    End If
                End If
            End If

            ' Copia la formattazione
            targetCell.NumberFormat = sourceCell.NumberFormat
            targetCell.TableBorder = sourceCell.TableBorder
        Next j
    Next i

    ' Copia le immagini
    targetPage = oSheetNuovo.getDrawPage()
    oDrawPage = oSheetDati.getDrawPage()

    For i = 0 To oDrawPage.getCount() - 1
        oShape = oDrawPage.getByIndex(i)

        If oShape.supportsService("com.sun.star.drawing.GraphicObjectShape") Then
            Dim newShape As Object
            Set newShape = oDocument.createInstance("com.sun.star.drawing.GraphicObjectShape")

            newShape.GraphicURL = oShape.GraphicURL

            Dim oPoint As New com.sun.star.awt.Point
            oPoint.X = oShape.Position.X
            oPoint.Y = oShape.Position.Y
            newShape.Position = oPoint

            Dim oSize As New com.sun.star.awt.Size
            oSize.Width = oShape.Size.Width
            oSize.Height = oShape.Size.Height
            newShape.Size = oSize

            newShape.GraphicCrop = oShape.GraphicCrop
            On Error Resume Next
            newShape.Name = oShape.Name
            newShape.ZOrder = oShape.ZOrder
            newShape.Transparency = oShape.Transparency
            newShape.GraphicColorMode = oShape.GraphicColorMode
            On Error GoTo 0

            targetPage.add(newShape)
        End If
    Next i

    MsgBox "Dati, formattazione e immagini copiati con successo dal foglio " & nomeFoglioOrigine & " al foglio " & nomeFoglioDestinazione
End Sub
questa invece è quella che mi restituisce errore con il tentativo di copiare le celle unite

Codice: Seleziona tutto

Sub CopiaValoriTestoConFormattazioneDaFoglioDinamico()

    ' Dichiarazione delle variabili
    Dim oDocument As Object
    Dim oSheetDati As Object
    Dim oSheetNuovo As Object
    Dim oCellaNomeOrigine As Object
    Dim oCellaNomeDestinazione As Object
    Dim nomeFoglioOrigine As String
    Dim nomeFoglioDestinazione As String
    Dim rangeDati As Object
    Dim sourceCell As Object
    Dim targetCell As Object
    Dim i As Integer
    Dim j As Integer
    Dim oShape As Object
    Dim targetPage As Object
    Dim oDrawPage As Object
    Dim bIsMerged As Boolean

    ' Ottieni il documento attivo (il file Calc aperto)
    oDocument = ThisComponent

    ' Ottieni il foglio attivo da cui prendere il nome del foglio di origine
    oSheetDati = oDocument.CurrentController.ActiveSheet

    ' Ottieni il nome del foglio di origine dalla cella O1
    oCellaNomeOrigine = oSheetDati.getCellRangeByName("O1")
    nomeFoglioOrigine = oCellaNomeOrigine.getString()

    ' Ottieni il nome del foglio di destinazione dalla cella F1
    oCellaNomeDestinazione = oSheetDati.getCellRangeByName("F1")
    nomeFoglioDestinazione = oCellaNomeDestinazione.getString()

    ' Controlla se il foglio di origine esiste
    On Error GoTo FoglioOrigineNonTrovato
    oSheetDati = oDocument.Sheets.getByName(nomeFoglioOrigine)

    ' Controlla se il foglio con lo stesso nome esiste già
    On Error GoTo CreaFoglio
    oSheetNuovo = oDocument.Sheets.getByName(nomeFoglioDestinazione)
    MsgBox "Un foglio con questo nome esiste già!"
    Exit Sub

FoglioOrigineNonTrovato:
    MsgBox "Il foglio di origine " & nomeFoglioOrigine & " non esiste."
    Exit Sub

CreaFoglio:
    ' Crea un nuovo foglio con il nome specificato
    oDocument.Sheets.insertNewByName(nomeFoglioDestinazione, oDocument.Sheets.getCount())
    oSheetNuovo = oDocument.Sheets.getByName(nomeFoglioDestinazione)

    ' Copia le dimensioni delle colonne e delle righe
    For i = 0 To 7 ' Per le colonne da A a H
        oSheetNuovo.Columns(i).Width = oSheetDati.Columns(i).Width
    Next i

    For i = 0 To 104 ' Per le righe da 1 a 105
        oSheetNuovo.Rows(i).Height = oSheetDati.Rows(i).Height
    Next i

    ' Specifica il range dei dati da copiare (celle da A1 a H105)
    rangeDati = oSheetDati.getCellRangeByName("A1:H105")

    ' Prima passa a copiare contenuti e formattazione
    For i = 0 To rangeDati.Rows.getCount() - 1
        For j = 0 To rangeDati.Columns.getCount() - 1
            sourceCell = rangeDati.getCellByPosition(j, i)
            targetCell = oSheetNuovo.getCellByPosition(j, i)

            ' Copia il contenuto della cella (valori, testo, formula)
            If sourceCell.Type = com.sun.star.table.CellContentType.EMPTY Then
                targetCell.clearContents(1023)
            ElseIf sourceCell.Type = com.sun.star.table.CellContentType.VALUE Then
                targetCell.Value = sourceCell.Value
            ElseIf sourceCell.Type = com.sun.star.table.CellContentType.TEXT Then
                targetCell.String = sourceCell.String
            ElseIf sourceCell.Type = com.sun.star.table.CellContentType.FORMULA Then
                If sourceCell.FormulaResultType = com.sun.star.table.CellContentType.TEXT Then
                    targetCell.String = sourceCell.String
                ElseIf sourceCell.FormulaResultType = com.sun.star.table.CellContentType.VALUE Then
                    If sourceCell.Value = 0 Then
                        targetCell.clearContents(1023)
                    Else
                        targetCell.Value = sourceCell.Value
                    End If
                End If
            End If

            ' Copia la formattazione
            targetCell.NumberFormat = sourceCell.NumberFormat
            targetCell.TableBorder = sourceCell.TableBorder
        Next j
    Next i

    ' Secondo passa per le celle unite
    For i = 0 To rangeDati.Rows.getCount() - 1
        For j = 0 To rangeDati.Columns.getCount() - 1
            sourceCell = rangeDati.getCellByPosition(j, i)

            ' Verifica se la cella è unita
            On Error Resume Next
            bIsMerged = sourceCell.IsMerged
            On Error GoTo 0

            If bIsMerged Then
                ' Ottieni il range delle celle unite
                Dim mergedRange As Object
                On Error Resume Next
                Set mergedRange = sourceCell.getMergedRegion()
                On Error GoTo 0

                If Not IsNothing(mergedRange) Then
                    ' Se getMergedRegion ha funzionato, usa il metodo standard
                    Dim targetMergeRange As Object
                    Set targetMergeRange = oSheetNuovo.getCellRangeByPosition( _
                        mergedRange.RangeAddress.StartColumn, _
                        mergedRange.RangeAddress.StartRow, _
                        mergedRange.RangeAddress.EndColumn, _
                        mergedRange.RangeAddress.EndRow)

                    targetMergeRange.merge(True)
                End If
            End If
        Next j
    Next i

    ' Copia le immagini
    targetPage = oSheetNuovo.getDrawPage()
    oDrawPage = oSheetDati.getDrawPage()

    For i = 0 To oDrawPage.getCount() - 1
        oShape = oDrawPage.getByIndex(i)

        If oShape.supportsService("com.sun.star.drawing.GraphicObjectShape") Then
            Dim newShape As Object
            Set newShape = oDocument.createInstance("com.sun.star.drawing.GraphicObjectShape")

            newShape.GraphicURL = oShape.GraphicURL

            Dim oPoint As New com.sun.star.awt.Point
            oPoint.X = oShape.Position.X
            oPoint.Y = oShape.Position.Y
            newShape.Position = oPoint

            Dim oSize As New com.sun.star.awt.Size
            oSize.Width = oShape.Size.Width
            oSize.Height = oShape.Size.Height
            newShape.Size = oSize

            newShape.GraphicCrop = oShape.GraphicCrop
            On Error Resume Next
            newShape.Name = oShape.Name
            newShape.ZOrder = oShape.ZOrder
            newShape.Transparency = oShape.Transparency
            newShape.GraphicColorMode = oShape.GraphicColorMode
            On Error GoTo 0

            targetPage.add(newShape)
        End If
    Next i

    MsgBox "Dati, formattazione, celle unite e immagini copiati con successo dal foglio " & nomeFoglioOrigine & " al foglio " & nomeFoglioDestinazione
End Sub
macOS 15.01 Sequoia: LibreOffice 24.8.2.1
Top
nickGiard
Messaggi: 84
Iscritto il: lunedì 14 maggio 2012, 22:04

Re: Macro per copiare foglio con aiuto di Chat GPT

Messaggio da nickGiard »

Mahh, non credo che Chat GPT possa aiutarti se nel passato qualcuno non ha postato una problematica identica, forse mi sbaglio.
Per iniziare ad affrontare il problema, ho visto che selezionando l'intero foglio, e poi in uno nuovo fare Incolla Speciale > Incolla Speciale > Valori e Formati vengono ricopiati i soli valori (come desideri) e mantenute le celle unite (come desideri) . Questa potrebbe essere già una parte della soluzione, che penso possa essere tradotta in codice abbastanza agevolmente.
Nicola con LibreOffice 7.1 (x64) su Windows 11
Top
Rispondi

Torna a “Macro e UNO API”