Pagina 1 di 1
[Risolto] Immagini come risultato
Inviato: martedì 1 ottobre 2019, 11:22
da 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!
Re: Immagini come risultato
Inviato: sabato 5 ottobre 2019, 0:45
da 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
Re: Immagini come risultato
Inviato: sabato 5 ottobre 2019, 8:20
da 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 ?
Re: Immagini come risultato
Inviato: martedì 15 ottobre 2019, 16:23
da 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!
Re: Immagini come risultato
Inviato: mercoledì 16 ottobre 2019, 1:15
da 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.
Re: Immagini come risultato
Inviato: mercoledì 16 ottobre 2019, 9:21
da 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.
Re: Immagini come risultato
Inviato: mercoledì 16 ottobre 2019, 14:38
da 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
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 8:51
da 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:
modifica:
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?
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 9:40
da Gaetanopr
giosipan ha scritto:
modifica:
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
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 9:55
da 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
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 11:00
da 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?
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 11:10
da 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.
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 11:26
da giosipan
Adesso funziona anche a me!
Ho copiato il tuo codice sostituendo i riferimenti giusti e adesso funziona benissimo!
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 11:29
da Gaetanopr
Re: Immagini come risultato
Inviato: venerdì 25 ottobre 2019, 11:38
da giosipan