Allegare 20k immagini in locale

[Davo]

Ciao ragazzi
Intanto grazie di esistere. Non sapete quante volte mi è venuto in soccorso il forum nei mesi passati anche senza essere registrato.
Sono Davo e da qualche mese ho iniziato a lavorare in modo un po' più attivo su Calc.
Oggi però sto sbattendo contro un muro di gomma. L'inserimento automatizzato di oltre 22mila png in formato 180x180 su di un Calc.
Ho cercato nel forum ma non ho trovato nulla che mi portasse a risolvere. Questo soprattutto a causa del mio totale analfabetismo sulla questione
Le immagini sono presenti in una cartella del mio desktop e sono rinominate con un semplice ID numerico, ID presente anche nella colonna A del foglio.
E' la prima volta che mi avvicino alle macro. Fino alla settimana scorsa neanche conoscevo l'esistenza.
Ho cercato di capirci qualcosa anche grazie a chatgpt, col quale, dopo numerosi tentativi,ho cercato di tirare giù un comando verosimile.
In questo momento il comando eseguito non sembra trovare errori di scrittura.
Non sembra, perchè in realtà dopo pochissimo mi arriva la notifica di lavoro concluso senza che nessuna immagine sia stata caricata.
Il fine ultimo di tutto questo? Creare un database che possa essere pubblicato nel mio sito internet.
Il foglio infatti è stato tutto strutturato per essere inserito direttamente su BASE (di cui sconosco anche lì l'ABC.....ma ho visto che funziona ahahah)

Vi allego prima le informazioni necessarie e successivamente il comando utilizzato
Macro - " InserisciImmagini "
Foglio - " db_face "
Pagina (unica nel foglio) - " DB "
Colonna con ID - " A " (ovviamente parte dalla cella 2 e si conclude con la cella 22039)
Estensione e formato immagini - " .png " e " 180x180 "
Percorso cartella immagini - " C:\Users\davok\Desktop\Miniface "

Questo il comando utilizzato
Sub InserisciImmagini()
On Error GoTo ErrorHandler

Dim oSheet As Object
Dim oCellRange As Object
Dim oCell As Object
Dim oDrawPage As Object
Dim oShape As Object
Dim sFolderPath As String
Dim sFileName As String
Dim iRow As Integer

' Imposta il nome del foglio
On Error Resume Next
Set oSheet = ThisComponent.Sheets.getByName("DB")
On Error GoTo ErrorHandler

If oSheet Is Nothing Then
MsgBox "Foglio 'DB' non trovato!"
Exit Sub
End If

' Ottieni il range delle celle da A2 a A22039
oCellRange = oSheet.getCellRangeByName("A2:A22039")
sFolderPath = "file:///C:/Users/davok/Desktop/Miniface/" ' Percorso della cartella delle immagini

' Ottieni il foglio di disegno
oDrawPage = oSheet.DrawPage

' Ciclo attraverso le celle specificate
For iRow = 0 To oCellRange.Rows.getCount() - 1
oCell = oCellRange.getCellByPosition(0, iRow)
sFileName = sFolderPath & oCell.getString() & ".png" ' Nome del file immagine

' Verifica se il file esiste
If FileExists(sFileName) Then
' Crea un nuovo oggetto immagine e imposta le proprietà
oShape = CreateGraphicObject(oDrawPage, sFileName)

' Imposta le dimensioni dell'immagine
oShape.setSize(1800, 1800)

' Posizione dell'immagine rispetto alla cella
oShape.setPosition(oCell.AbsolutePosition.X + 10000, oCell.AbsolutePosition.Y)

' Aggiungi l'oggetto grafico alla pagina di disegno
oDrawPage.add(oShape)

' Aggiorna il documento
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
oDrawPage.Add(oShape)
End If
Next iRow

MsgBox "Inserimento immagini completato!"

Exit Sub

ErrorHandler:
MsgBox "Errore durante l'accesso al foglio 'DB': " & Err.Description
Exit Sub
End Sub

Mi scuso se ho trascurato qualche passaggio e se sono stato prolisso.
Fustigatemi a dovere
Grazie

[Gaetanopr]

Non sembra, perchè in realtà dopo pochissimo mi arriva la notifica di lavoro concluso senza che nessuna immagine sia stata caricata.

Ti arriva la notifica di avvenuto caricamento in quanto il gestore degli errori ti evita di vedere quello che succede e dove sbaglia la macro, comunque sul forum l'argomento è stato trattato diverse volte.
Ti allego una macro che ti carica le immagini nella colonna B da riga 2 a 10, purtroppo non ho 22000 immagini .

Codice: Seleziona tutto

Sub InserisciImmagini 
Dim positionImage As New com.sun.star.awt.Point
Dim props(0) As New com.sun.star.beans.PropertyValue
Doc = ThisComponent
fpath = "file:///C:/Users/Gaetano/Desktop/Miniface/" ' <<<<<<<<< da modficare

Sh = Doc.sheets.getByName("DB")
for riga = 2 to 10
  img = Sh.getCellRangeByName("A" & riga).String
  ITarget = Sh.getCellRangeByName("B" & riga)
  rowHeight = Sh.Rows(Itarget.CellAddress.Row).Height
  colWidth = Sh.Columns(Itarget.CellAddress.Row).Width
'  addr = Targ.cellAddress
  Drw = Sh.DrawPage
  Gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
  props(0).Name = "URL"
  props(0).Value = fpath & img & ".png"
  Image=Doc.createInstance("com.sun.star.drawing.GraphicObjectShape")
  Image.Graphic = Gp.queryGraphic( props() )
' Controllo se è presente l'immagine in archivio
  If IsNull(Image.Graphic) Then MsgBox "Immagine non presente in archivio" : exit sub
'   Aggiungo l'immagine   
  Drw.add(Image)
' Ridimensiono l'immagine
  Larg =  180
 ' resizeImageByWidth(Image,colWidth, rowHeight) ' LARGHEZZA E ALTEZZA CELLA OPPURE 
  resizeImageByWidth(Image,180, 180)
  
  positionImage.x = ITarget.position.x
  positionImage.y = ITarget.position.y
  Image.Position = positionImage
  Image.Name = NomeImage
next  
End Sub

Sub resizeImageByWidth(ImageCmp As Object, Larg As Long, alt as long)
Dim imageInfo As Object, Proporzione As Double, SizeImage As Object
imageInfo = ImageCmp.Graphic
SizeImage = imageInfo.SizePixel
SizeImage.Width = Larg
SizeImage.Height = alt
ImageCmp.Size = SizeImage
End Sub