[Risolto] Immagini come risultato

[giosipan]

Buongiorno a tutti!
Ho di nuovo bisogno del vostro aiuto per l'argomento in oggetto.
Quello che vorrei ottenere è questo:

1- richiamare delle immagini in una determinata cella del foglio n.2 (e cancellazione dell'eventuale immagine precedente) a secondo del valore presente in un'altra cella del foglio n.1;
2- ripetizione delle immagini dal foglio n.3 al foglio n.6;
3- impostazione delle immagini sullo sfondo del livello.

Le celle sono:
- INPUT 1 - cella B16 foglio1
risultato in cella F76 foglio2

- INPUT 2 - cella B19 foglio 1
risultato in cella K79 foglio 2

Spero di essere stato chiaro.
Grazie!

[unlucky83]

Buonasera. Tutto ciò si può fare con macro, ma non sei stato molto chiaro.
L'immagine modello da ripetere dove si trova?
Hai un archivio di immagini salvate in un foglio?

Un allegato può aiutare a capire

[patel]

sembra proprio che tu non abbia voglia di risolvere, ti costa così tanta fatica spiegare bene, mettere un link alla discussione precedente evidenziando le differenze rispetto al problema già risolto ?

[giosipan]

Buonasera,
scusate se riscrivo solo adesso e soprattutto scusate se non sono stato molto chiaro nella mia richiesta ma purtroppo non sono un frequente utilizzatore di forum e non conosco tutte le dinamiche che ci sono all'interno di esso.
Ci riprovo sperando di riuscire nel mio intento.
La mia richiesta è questa:

- Nel primo foglio del file, che ho chiamato "Input", inserisco dei valori che richiamo da un elenco a discesa. Le celle di input sono due, "B13" e "B14";
- Ad ogni valore che richiamo nelle due celle il programma deve inserire un'immagine rispettivamente nelle celle "B19" e "E19" dei fogli 2-3-4-5-6 e impostarla nello sfondo del livello;
- Ogni volta che inserisce un'immagine nuova la precedente viene cancellata;
- Le immagini sono tutte .jpg della stessa grandezza e si trovano sulla cartella "Image" che si trova sulla stessa "root" del file .ods.

Tempo fa chiesi aiuto su questo forum per una cosa simile (viewtopic.php?f=9&t=8030&p=43342#p43342) e siete riusciti a risolvere il problema.
La differenza dalla precedente richiesta è solo nelle celle di input che mentre prima erano nello stesso foglio dove venivano richiamate l'immagini, adesso si trovano nel foglio precedente.

Spero stavolta di essere stato più chiaro... grazie in anticipo per l'eventuale aiuto che potrete darmi.
Buon lavoro!

[unlucky83]

Ciao. Per essere informato sulle novità nelle discussioni che apri e a cui partecipi, imposta l'invio di notifiche sulla casella di posta elettronica-
L'allegato che hai presentato in questa discussione ha solo 4 caselle colorate di cui due presentano un menu a tendina. Non mi sembra un grandissimo esempio.
Hai riportato il link alla precedente discussione e visionandola ho visto che ci sono più macro ma non ho capito alla fine qual è la versione definitiva che stavi usando fino al momento di dover cambiare le celle di input. Ho quindi controllato il tuo ultimo allegato nella speranza di trovarci dentro la macro, ma in essa non è presente nessuna macro.
Quando dici

La differenza dalla precedente richiesta è solo nelle celle di input che mentre prima erano nello stesso foglio dove venivano richiamate l'immagini, adesso si trovano nel foglio precedente.

mi viene in mente che alla macro bisogna solo cambiare dei riferimenti...cioè un'inezia.
Potresti riportare nel prossimo messaggio il codice della macro? Grazie.

[giosipan]

Buongiorno unlucky83 e grazie per la risposta.
In effetti la macro funziona benissimo e dovrei cambiare solo i riferimenti.
Questa è la macro:

Codice: Seleziona tutto

Sub Immagine1(Target)
Dim Sh As Object, addr As Object
Dim Doc As Object
Dim Drw As Object, Image As Object, Gp As Object
Dim positionImage As New com.sun.star.awt.Point
Dim props(0) As New com.sun.star.beans.PropertyValue
Doc = ThisComponent
fpath = left(Doc.geturl(),revinstr(Doc.geturl(),"/"))
Sh = Target.getSpreadsheet()
oCellT() = Split(Target.AbsoluteName, ".")
oCellTarget = oCellT(1)
If oCellTarget = "$B$17" Or oCellTarget = "$B$20" Then
   If oCellTarget = "$B$17" Then 
      ITarget = sh.getCellRangeByName("E79") ' serve per le coordinate di inserimento dell'immagine
      oCell = "$E$79"
   ElseIf oCellTarget = "$B$20" Then 
      ITarget = sh.getCellRangeByName("K79") ' serve per le coordinate di inserimento dell'immagine
      oCell = "$K$79"
   End If

   NomeImage =  Target.String
   For s = 0 To 5
      Gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
      props(0).Name = "URL" '   D:\Users\Gaetano\Desktop\download.png
      props(0).Value = fpath & "Firme/" & NomeImage & ".jpg" '("C:\Documents and Settings\Administrator\Desktop\" & NomeImage & ".jpg")
      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
        ' Elimino se presente immagine precedente nella cella di destinazione
        Drw = Doc.sheets(s).DrawPage
        For i = 0 To Drw.Count - 1
            CellaImmagine() = Split(Drw(i).Anchor.AbsoluteName, ".")
            If  CellaImmagine(1) = oCell Then
                Drw.Remove(Drw(i))
                Exit For
            End If   
       Next i

    '   Aggiungo l'immagine   
        Drw.add(Image)
      ' Ridimensiono l'immagine
       Larg =  10000
       resizeImageByWidth(Image,Larg) 

       positionImage.x = ITarget.position.x
       positionImage.y = ITarget.position.y
       Image.Position = positionImage
       Image.Name = NomeImage
       Image.Anchor = Doc.Sheets(s).getCellrangebyname(oCell) 
       Image.LayerId = 1  'imposta l'immagine sullo sfondo

  Next s

End if
End Sub

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

function revinstr(s as string, slash as string) as string
    dim ii as integer
   ii=0
   do
   if instr(ii+1,s,slash)=0 then exit do
      ii=instr(ii+1,s,slash)
   loop
   revinstr = ii
end function

Le celle di input al momento si trovano sullo stesso foglio dove viene richiamata l'immagine e invece io vorrei inserirle in un foglio precedente e su questo foglio non devono apparire le immagini.

[unlucky83]

Guardando la macro, sono diverse anche le celle di output. La macro da quale evento viene avviata? Sembra da un evento delle celle e per gestire gli eventi delle celle in genere ci sono altre macro da usare che usano il listener, ma qui non le vedo. Se sai essere più specifico comprendo che oggetto sia Target.
Sorvolando su questo, direi che devi cambiare certamente i riferimenti delle celle di input, quindi

Codice: Seleziona tutto

If oCellTarget = "$B$17" Or oCellTarget = "$B$20" Then
   If oCellTarget = "$B$17" Then
     ...
   ElseIf oCellTarget = "$B$20" Then

deve diventare

Codice: Seleziona tutto

If oCellTarget = "$B$19" Or oCellTarget = "$E$16" Then
   If oCellTarget = "$B$19" Then
     ...
   ElseIf oCellTarget = "$E$19" Then

Per modificare le celle di output dovresti inserire nel codice

Codice: Seleziona tutto

 dim shs(4)
shs(0)=Doc.Sheets.getbyName("Foglio2")
shs(1)=Doc.Sheets.getbyName("Foglio3")
shs(2)=Doc.Sheets.getbyName("Foglio4")
shs(3)=Doc.Sheets.getbyName("Foglio5")
shs(4)=Doc.Sheets.getbyName("Foglio6")

così hai un array di oggetti con i fogli di output. Per le celle di output non capisco quale dobbiamo considerare...nel primo msg parli di F76 e K79 dei 5 fogli, nell'allegato hai colorato le celle B19 ed E19 di foglio2 mentre nel codice della macro vedo E79 e K79.
Sono necessarie altre modifiche perchè la macro che hai fornito non prevedeva che tu avresti cambiato l'ordine dei fogli e aggiunto un altro all'inizio. Bisogna cambiare qualcosa anche nel ciclo.
Inoltre mi dovresti spiegare cosa c'era in E79 e K79 del foglio che avvia la macro...così capisco a cosa serviva l'oggetto cella iTarget

Codice: Seleziona tutto

ITarget = sh.getCellRangeByName("E79")
...
ITarget = sh.getCellRangeByName("K79")

Le modifiche da fare sono un pò più elaborate di quanto ho detto nel messaggio precedente. Prima di andare avanti hai compreso il significato di queste modifiche? Più cose comprendi del codice e più sarai autosufficiente e potrai apportare ulteriori modifiche quando si renderà necessario

[giosipan]

Buongiorno unlucky83,
ho avuto poco tempo purtroppo per provare le modifiche che mi hai proposto.
Comunque riguardando il codice, di mia iniziativa, ho apportato una semplice modifica:

codice originario:

Codice: Seleziona tutto

NomeImage =  Target.String
   For s = 0 To 5

modifica:

Codice: Seleziona tutto

NomeImage =  Target.String
   For s = 1 To 5

e così facendo l'inserimento dell'immagine parte dal foglio 2 e si ripete fino al foglio 5!
Non so se è corretto, però funziona.
Cosa ne pensi?

[Gaetanopr]

modifica:

Codice: Seleziona tutto

NomeImage =  Target.String
   For s = 1 To 5

e così facendo l'inserimento dell'immagine parte dal foglio 2 e si ripete fino al foglio 5!
Non so se è corretto, però funziona.
Cosa ne pensi?

Buongiorno, mi intrometto nella discussione, giosipan la correzione è corretta, da foglio2 a foglio6 per essere precisi, naturalmente devi cambiare anche i riferimenti iniziali come sicuramente avrai fatto

Codice: Seleziona tutto

Sub Immagine1(Target)
Dim Sh As Object, addr As Object
Dim Doc As Object
Dim Drw As Object, Image As Object, Gp As Object
Dim positionImage As New com.sun.star.awt.Point
Dim props(0) As New com.sun.star.beans.PropertyValue
Doc = ThisComponent
fpath = left(Doc.geturl(),revinstr(Doc.geturl(),"/"))
Sh = Target.getSpreadsheet()
oCellT() = Split(Target.AbsoluteName, ".")
oCellTarget = oCellT(1)
If oCellTarget = "$B$13" Or oCellTarget = "$B$14" Then
   If oCellTarget = "$B$13" Then
      ITarget = sh.getCellRangeByName("B19") ' serve per le coordinate di inserimento dell'immagine
      oCell = "$B$19"
   ElseIf oCellTarget = "$B$14" Then
      ITarget = sh.getCellRangeByName("E19") ' serve per le coordinate di inserimento dell'immagine
      oCell = "$E$19"
   End If

   NomeImage =  Target.String
   For s = 1 To 5
      Gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
      props(0).Name = "URL" '   D:\Users\Gaetano\Desktop\download.png
      props(0).Value = fpath & "Firme/" & NomeImage & ".jpg" '("C:\Documents and Settings\Administrator\Desktop\" & NomeImage & ".jpg")
     ' props(0).Value = fpath & NomeImage & ".jpg" '("C:\Documents and Settings\Administrator\Desktop\" & NomeImage & ".jpg")
      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
        ' Elimino se presente immagine precedente nella cella di destinazione
        Drw = Doc.sheets(s).DrawPage
        For i = 0 To Drw.Count - 1
            CellaImmagine() = Split(Drw(i).Anchor.AbsoluteName, ".")
            If  CellaImmagine(1) = oCell Then
                Drw.Remove(Drw(i))
                Exit For
            End If   
       Next i

    '   Aggiungo l'immagine   
        Drw.add(Image)
      ' Ridimensiono l'immagine
       Larg =  10000
       resizeImageByWidth(Image,Larg)

       positionImage.x = ITarget.position.x
       positionImage.y = ITarget.position.y
       Image.Position = positionImage
       Image.Name = NomeImage
       Image.Anchor = Doc.Sheets(s).getCellrangebyname(oCell)
       Image.LayerId = 1  'imposta l'immagine sullo sfondo

  Next s

End if
End Sub

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

function revinstr(s as string, slash as string) as string
    dim ii as integer
   ii=0
   do
   if instr(ii+1,s,slash)=0 then exit do
      ii=instr(ii+1,s,slash)
   loop
   revinstr = ii
end function

[giosipan]

Buongiorno Gaetanopr!
Si ho cambiato i riferimenti iniziali e i fogli sono dal 2 al 6.
L'unico problema, ma mi sono accorto che era presente anche prima di queste ultime modifiche, è che non mi cancella le immagini precedentemente richiamate... me le mette una sopra l'altra.
Riesci a capirne il motivo?

Codice: Seleziona tutto

 Drw = Doc.sheets(s).DrawPage
        For i = 0 To Drw.Count - 1
            CellaImmagine() = Split(Drw(i).Anchor.AbsoluteName, ".")
            If  CellaImmagine(1) = oCell Then
                Drw.Remove(Drw(i))
                Exit For
            End If   
       Next i

[Gaetanopr]

Se la macro che usi è come quella che ti ho allegato dovrebbe funzionarti, a me funziona sia su openoffice che libreoffice.
Hai apportato modifiche oltre a quelle descritte prima?

[giosipan]

La macro che uso è questa:

Codice: Seleziona tutto

Sub Immagine1(Target)
Dim Sh As Object, addr As Object
Dim Doc As Object
Dim Drw As Object, Image As Object, Gp As Object
Dim positionImage As New com.sun.star.awt.Point
Dim props(0) As New com.sun.star.beans.PropertyValue
Doc = ThisComponent
fpath = left(Doc.geturl(),revinstr(Doc.geturl(),"/"))
Sh = Target.getSpreadsheet()
oCellT() = Split(Target.AbsoluteName, ".")
oCellTarget = oCellT(1)
If oCellTarget = "$D$4" Or oCellTarget = "$D$22" Then
   If oCellTarget = "$D$4" Then 
      ITarget = sh.getCellRangeByName("E79") ' serve per le coordinate di inserimento dell'immagine
      oCell = "$E$79"
   ElseIf oCellTarget = "$D$22" Then 
      ITarget = sh.getCellRangeByName("K79") ' serve per le coordinate di inserimento dell'immagine
      oCell = "$K$79"
   End If

   NomeImage =  Target.String
   For s = 1 To 5
      Gp = createUnoservice("com.sun.star.graphic.GraphicProvider")
      props(0).Name = "URL" '   D:\Users\Gaetano\Desktop\download.png
      props(0).Value = fpath & "Firme/" & NomeImage & ".jpg" '("C:\Documents and Settings\Administrator\Desktop\" & NomeImage & ".jpg")
      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
        ' Elimino se presente immagine precedente nella cella di destinazione
        Drw = Doc.sheets(s).DrawPage
        For i = 0 To Drw.Count - 1
            CellaImmagine() = Split(Drw(i).Anchor.AbsoluteName, ".")
            If  CellaImmagine(1) = oCell Then
                Drw.Remove(Drw(i))
                Exit For
            End If   
       Next i

    '   Aggiungo l'immagine   
        Drw.add(Image)
      ' Ridimensiono l'immagine
       Larg =  10000
       resizeImageByWidth(Image,Larg) 

       positionImage.x = ITarget.position.x
       positionImage.y = ITarget.position.y
       Image.Position = positionImage
       Image.Name = NomeImage
       Image.Anchor = Doc.Sheets(s).getCellrangebyname(oCell) 
       Image.LayerId = 1  'imposta l'immagine sullo sfondo

  Next s

End if
End Sub

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

function revinstr(s as string, slash as string) as string
    dim ii as integer
   ii=0
   do
   if instr(ii+1,s,slash)=0 then exit do
      ii=instr(ii+1,s,slash)
   loop
   revinstr = ii
end function

però non mi cancella le immagini.

[giosipan]

Adesso funziona anche a me!
Ho copiato il tuo codice sostituendo i riferimenti giusti e adesso funziona benissimo!

[Gaetanopr]

[giosipan]

Ancora grazie mille!!!