| | Post: 6.512 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
20/09/2021 12:12 | |
Ciao a tutti allora con una macro sono riuscito ad inserire, l'immagine dello scudetto e farla posizionare soltanto sull'ultimo valore, adesso resta il problema delle etichette, cioè l'accavallamento delle stesse.
nella classifica del campionato succede che alcune squadre sono a pari merito con lo stesso punteggio, questo il grafico risultante
i pulsanti sotto sono per visualizzare o nascondere la serie della squadra
quindi dal grafico ho estrapolato tutte le coordinate delle etichette, queste ma allego anche il file delle etichette, questa un immagine.
vorrei trovare una soluzione al problema
per la verità ho escluso a parer mio di disporre le etichette su piani diversi, credo troppo complicato, anche perche non sempre si ha un numero fisso di squadre a pari merito.
quindi ho pensato di mettere le etichette una di seguito all'altra sullo stesso piano, per fare questo avrei bisogno di calcolare una cosa del genere
avendo il TOP fisso per ogni punteggio in classifica e quindi al primo passaggio di un punteggio ho la partenza Top-Left, a questo ci dovrei aggiungere il "Width" che è la lunghezza dell'etichetta, cioè trovo un nuovo Left che sarabbe il Left+Widt+spazio, quindi al secondo TOP con lo stesso numero il Left della prossima etichetta dovrebbe partire dalla formula del calcolo del Left, e ricalcolare il nuovo Left con il nuovo Width, non sono uguali, varia la lunghezza in base al nome della squadra.
il problema non posso fare un ordinamento sulla tabella perche perdo i riferimenti delle serie del grafico, nell'ultima colonna dovrei inserire il calcolo del Left successivo per posizionare la prossima etichetta.
se avete qualche idea migliore sono pronto ad accettare ogni suggerimento, io al momento ho pensato questo.
Ciao By Sal (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
|
| | Post: 936 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
20/09/2021 14:24 | |
Ciao
In mancanza del file sul quale poter eseguir prove vedi se può esserti utile quest mia macro a questo indirizzo
https://www.excelacademy.it/supporto/macro-e-vba/vba-per-spostare-etichette-sovrapposte-in-un-grafico-a-dispersione/#post-924
Fai sapere. Ciao,
Mario |
| | Post: 6.512 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
20/09/2021 18:05 | |
Ciao Mario ho provato le tue due macro, ma purtroppo non funzionano, o meglio funzionano, ma non credo siano adatte per un grafico a Linee, più per un grafico a dispersione, come vedi il risultato
e questa
mentre invece con questa credo che sia la soluzione finale, vedi la disposizione che avviene sulla stessa quota Top
allego anche il file, la macro l'ho nominata "Complessa"
devo però vedere con la prossima Giornata di Calcio come si comporta, non vorrei che ci fossero problemi, inserendo una nuova giornata.
Ciao Salvatore [Modificato da by sal 20/09/2021 18:08] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 937 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
20/09/2021 18:25 | |
Ciao
Era quel che volevo provare se avessi avuto il file sottomano.
Adesso ce l'ho e volevo apportare una modifica. Nel grafico appaiono le squadre ed il punteggio relativo separati da da un punto e virgola mentre gli scudetti sono accavallati. Sarebbe interessante poter mettere davanti (ed una sola volta) i punti conseguiti e via via il singolo scudetto e la relativa squadra.
Non posso provarlo perchè mi manca il file con le immagini.
Ciao,
Mario
PS - Salvatore mi sai dire perchè, pur avendo io la vers.2010 di Excel, mi dà errore con FullSeriesCollection e nessuno se modifico in SeriesCollection? |
| | Post: 6.514 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
20/09/2021 18:34 | |
Ciao Mario purtroppo la versione 2010 non riconosce la sequenza del comando della 2016 ed oltre, si deve dare il comando vecchio.
per la verità anche io avevo pensato di allegare lo scudetto nell'immagine dell'etichetta, ma non ho trovato il modo.
non so se si possa spostare l'indicatore, ma credo che sia legato alla punta della serie, se poi riesci, bene.
nel frattempo vedo di prepararti una cartella con le immagini degli scudetti, non posso mandartela tutta perche è molto grande contiene anche i calciatori, se poi la vuoi posso vedere di allegarla..
per il momento Ciao Salvatore
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 6.515 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
21/09/2021 07:45 | |
Ciao Marius, ecco la cartella con gli scudetti, ma come immaginavo una volta che l'etichetta ha preso una posizione, tende a mantenerla, vedi il Napoli, che ho inserito stamattina.
si trovava in mezzo a Fiorentina Roma, è salito solo di posizione del valore, non si è avvicinato vicino allo scudetto
perciò volevo sapere se è possibile sapere la posizione della Linea della serie, cioè diciamo dove adesso è lo scudetto, in modo che avrei un punto top-left di partenza.
la cartella l'ho compressa perche non mi fa allegare una cartella
Ciao By Sal (8-D
[Modificato da by sal 21/09/2021 07:48] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 6.516 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
21/09/2021 08:06 | |
Ciao OK sono riuscito a prendere la posizione di partenza della serie, quindi ho risolto un altro punto.
ora la situazione è questa
Ciao By Sal (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 938 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
21/09/2021 16:38 | |
Ciao Salvatore
Ho "manipolato" la macro Complessa che è diventata così
Sub Complessa()
Dim r, c, x, y, d, p, n, T, L, H, W, LL, k, ind, rng
Sheets("Grafico2").Select
ind = ActiveWorkbook.Path & "\Immagini\"
Range("AG2:AK21") = ""
Range("AN2:AO21") = ""
rng = Range("AB2:Ak21")
n = 2
ActiveSheet.ChartObjects("Grafico 2").Activate
For x = 1 To 20
d = rng(x, 3)
p = rng(x, 4)
If p <> 0 Then
ActiveChart.SeriesCollecti0n(d).Select
ActiveChart.SeriesCollecti0n(d).Points(p).Select
With Selection
T = Int(.Top)
.MarkerStyle = -4142
.MarkerSize = 5
End With
'Selection.MarkerStyle = -4147
'If rng(x, 5) <> "" Then
' With Selection.Format.Fill
'.Visible = msoTrue
'.UserPicture ind & rng(x, 5)
' End With
'End If
ActiveChart.SeriesCollecti0n(d).ApplyDataLabels
ActiveChart.SeriesCollecti0n(d).DataLabels.Select
ActiveChart.SeriesCollecti0n(d).HasLeaderLines = False
For y = p - 1 To 1 Step -1
ActiveChart.SeriesCollecti0n(d).Points(y).DataLabel.Delete
Next y
ActiveChart.SeriesCollecti0n(d).Points(p).DataLabel.Select
With Selection
.ShowSeriesName = -1
L = Int(.Left)
' T = Int(.Top)
H = Int(.Height)
W = Int(.Width)
Cells(x + 1, 33) = T
Cells(x + 1, 34) = L
Cells(x + 1, 35) = H
Cells(x + 1, 36) = W
If x = 1 Then Cells(n, 40) = T: Cells(n, 41) = L + W + 3: n = n + 1: GoTo 1
k = 0
For y = 2 To n
If Cells(y, 40) = T Then LL = Cells(y, 41): k = 1: Exit For
Next y
If k = 1 Then
.Left = LL
' .Top = T
LL = LL + W + 3
Cells(y, 41) = LL
End If
If k = 0 Then
LL = L
.Left = LL
' .Top = T
LL = LL + W + 3
Cells(n, 40) = T
Cells(n, 41) = LL
n = n + 1
End If
Stop
'inserisco forma e logo
ActiveChart.Shapes.AddShape(msoShapeRoundedRectangle, L, T, 20, 20).Select
Selection.ShapeRange.Line.Visible = msoFalse
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture ind & rng(x, 5)
.TextureTile = msoFalse
End With
'Stop
End With
End If
1 Next x
Cells(1, 1).Select
MsgBox "Operazione terminata"
End Sub
Ho remmato la parte che inseriva il logo della squadra nel Marker, cioè questa parte
....
'Selection.MarkerStyle = -4147
'If rng(x, 5) <> "" Then
' With Selection.Format.Fill
'.Visible = msoTrue
'.UserPicture ind & rng(x, 5)
' End With
'End If
....
ed ho aggiunto queste righe che inseriscono un rettangolo smussato, senza riempimento e senza bordo, nel quale inserisco il logo della squadra.
Così non si accavallano più. Vedi che c'è uno Stop
Non mi riesce di distanziarli opportunamente per metterli ognuno davanti al nome della squadra. Ho capito che bisognerebbe intervenire nel valore di L - cioè in questa riga ActiveChart.Shapes.AddShape(msoShapeRoundedRectangle, L, T, 20, 20) - ma non riesco.
Ciao,
Mario |
| | Post: 6.519 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
21/09/2021 17:26 | |
Ciao Mario bravissimo, ad inserire il logo, ma succede una cosa si moltiplicano ad ogni lancio della macro, come vedi
e come vedrai li ho spostati sull'asse delle etichette,
ora devo/dobbiamo vedere di non far replicare il logo, e cercherò di far posizionare il logo non so se meglio alla fine oppure all'inizio dell'etichetta, ora provo e vedo cosa ne esce fuori.
cioè in questa riga ActiveChart.Shapes.AddShape(msoShapeRoundedRectangle, L, T, 20, 20) - ma non riesco.
credo che bisogna costruire un insieme di Logo ed etichetta, in modo che la prossima serie a pari punteggio parte dal prossimo "L" colonna "AO" e li che avviene l'aggiornamento della "L" cioè questa è la parte che determina il calcolo della "LL" successiva e quindi inserire il logo cioè 20+spazio, perche "W" è la lunghezza dell'etichetta
If k = 0 Then
LL = L
.Left = LL
.Top = T
LL = LL + W + 3
Cells(n, 40) = T
Cells(n, 41) = LL
n = n + 1
End If
il codice che hai "Remmato", serviva per caricare il logo nell'indicatore della serie, però ho visto che lo carichi in maniera diversa, ma cosi è meglio
per il momento, Ciao Salvatore
[Modificato da by sal 21/09/2021 17:42] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 939 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
21/09/2021 18:35 | |
Ciao
La macro che ti posto elimina i loghi. Forse è il caso di richiamarla all'inizio di ogni lancio della macro Complessa
Sub Elimina_Loghi()
Dim i As Long
ActiveSheet.ChartObjects(1).Activate
For i = ActiveChart.Shapes.Count To 1 Step -1
If Left(ActiveChart.Shapes(i).Name, 5) = "Round" Then
ActiveChart.Shapes(i).Delete
End If
Next
End Sub
Ciao,
Mario |
| | Post: 940 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
22/09/2021 16:02 | |
Ciao Salvatore
Ho modificato un po' la macro (anzi, è quasi nuova) ed ho aggiunto una funzione. Mantieni la macro che cancella i loghi.
Questo il codice
Sub Complex()
Dim a, r, c, x, y, d, p, n, T, L, H, W, LL, k, ind, rng, pd
Sheets("Grafico2").Select
ind = ActiveWorkbook.Path & "\Immagini\"
rng = Range("AB2:AF21")
ActiveSheet.ChartObjects("Grafico 2").Activate
'cancella etichette pecedenti
On Error Resume Next
For a = 1 To ActiveChart.SeriesCollection.Count
ActiveChart.SeriesCollecti0n(a).DataLabels.Delete
Next a
On Error GoTo 0
Call Elimina_Loghi
'
For x = 1 To 20
d = rng(x, 3) 'numero serie
p = rng(x, 4) 'punto della serie
If p <> 0 Then
With ActiveChart.SeriesCollecti0n(d)
.Select
.ApplyDataLabels
.DataLabels.Select
For y = p - 1 To 1 Step -1
.Points(y).DataLabel.Delete
Next y
With .Points(p)
.Select
.MarkerStyle = xlMarkerStyleCircle
T = Int(.Top)
.DataLabel.Select
With Selection
.ShowSeriesName = -1 'squadra
.ShowValue = False 'elimino il valore
L = Int(.Left) + 20
W = Int(.Width)
pd = PosDestra(L, T, W) 'UDF per posizione
.Left = pd 'sposto l'etichetta
End With
End With
End With
'inserisco forma e logo
ActiveChart.Shapes.AddShape(msoShapeRoundedRectangle, pd - 20, T - 10, 20, 20).Select
Selection.ShapeRange.Line.Visible = msoFalse
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture ind & rng(x, 5)
.TextureTile = msoFalse
End With
End If
Next
Cells(1, 1).Select
MsgBox "Operazione terminata"
End Sub
Function PosDestra(ByVal L As Integer, ByVal T As Integer, ByVal W As Integer) As Integer
Dim i As Long, n As Integer, aa
ActiveSheet.ChartObjects(1).Activate
For i = ActiveChart.Shapes.Count To 1 Step -1
If Left(ActiveChart.Shapes(i).Name, 5) = "Round" Then
If ActiveChart.Shapes(i).Top = T - 10 Then
n = n + 1
End If
End If
Next
If n = 0 Then
PosDestra = 158
Else
PosDestra = L + (n * 70)
End If
End Function
Sub Elimina_Loghi()
Dim i As Long
ActiveSheet.ChartObjects(1).Activate
For i = ActiveChart.Shapes.Count To 1 Step -1
If Left(ActiveChart.Shapes(i).Name, 5) = "Round" Then
ActiveChart.Shapes(i).Delete
End If
Next
End Sub
Con la correzione apportata (ho modificato e ripulito il codice) sembra che etichette e loghi vadano bene.
Unico neo Hellas Verona a causa della dicitura troppo lunga (si potrebbe accorciare in H.Verona)
Fai sapere. Ciao,
Mario [Modificato da Marius44 22/09/2021 22:17] |
| | Post: 941 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
23/09/2021 08:52 | |
Ciao
Vedo che ancora non hai provato il codice del precedente post. Mi farai sapere.
Stamani, rivedendo il codice, mi è sorto un dubbio.
Le etichette e i loghi delle squadre trovano la loro giusta collocazione ma siamo appena alla 4/5^ giornata. E se fossimo alla 37^? Oppure alla 38^? Tante squadre a pari merito andrebbero fuori visibilità. E' il caso di intervenire nella larghezza dell'area del Grafico?
Ciao,
Mario |
| | Post: 6.521 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
23/09/2021 09:20 | |
Ciao Mario ci sto lavorando, sono riuscito a sistemare i loghi dopo l'etichetta, ma comunque sorge un problema, questo lo stato attuale
il problema te lo dimostro nell'immagine successiva, i pulsanti in basso servono a visualizzare o nascondere alcune squadre oppure tutte, vedi che succede.
come vedi quando aggiorno si aggiorna tutto regolarmente, però se cancello tutte le squadre, come vedi mi rimangono i loghi, dovrebbero scomparire anche quelli, ed inoltre quando visualizzo una squadra logicamente il Logo e l'etichetta se prima non erano vicini alla serie si posizionano lontano.
si dovrebbe aggiornare tutto in base alle selezioni che faccio, comunque sono passi successivi che farò.
nel frattempo ti allego la Macro Complessa che ho aggiornato, ed inoltre avendo difficoltà nell'aggiungere il logo con la stessa macro, perche andava in conflitto, ho creato una SubRoutine che aggiunge il logo che allego anche quella.
Sub Complessa()
Dim r, c, x, y, d, p, n, T, L, H, W, LL, k, ind, rng
Sheets("Grafico2").Select
ind = ActiveWorkbook.Path & "\Immagini\"
Range("AG2:AK21") = ""
Range("AN2:AO21") = ""
rng = Range("AB2:Ak21")
n = 2
ActiveSheet.ChartObjects("Grafico 2").Activate
For x = 1 To 20
d = rng(x, 3)
p = rng(x, 4)
If p <> 0 Then
ActiveChart.FullSeriesCollecti0n(d).Select
ActiveChart.FullSeriesCollecti0n(d).Points(p).Select
With Selection
T = Int(.Top)
L = Int(.Left)
.MarkerStyle = -4142
End With
ActiveChart.FullSeriesCollecti0n(d).ApplyDataLabels
ActiveChart.FullSeriesCollecti0n(d).DataLabels.Select
ActiveChart.FullSeriesCollecti0n(d).HasLeaderLines = False
For y = p - 1 To 1 Step -1
ActiveChart.FullSeriesCollecti0n(d).Points(y).DataLabel.Delete
Next y
ActiveChart.FullSeriesCollecti0n(d).Points(p).DataLabel.Select
With Selection
.ShowSeriesName = -1
H = Int(.Height)
W = Int(.Width)
Cells(x + 1, 33) = T
Cells(x + 1, 34) = L
Cells(x + 1, 35) = H
Cells(x + 1, 36) = W
If x = 1 Then Cells(n, 40) = T: Cells(n, 41) = L: LL = Cells(n, 41): GoTo 1
k = 0
For y = 2 To n
If Cells(y, 40) = T Then LL = Cells(y, 41): k = 1: Exit For
Next y
1 If k = 1 Then
.Left = LL
Call Logo(LL, T, W, rng(x, 5)) 'richiama inserimento logo
LL = LL + 20 'aumenta il Left per la larghezza del logo
Cells(y, 41) = LL
End If
If k = 0 Then
LL = L
.Left = LL
Call Logo(LL, T, W, rng(x, 5)) 'richiama inserimento logo
LL = LL + 20 'aumenta il Left per la larghezza del logo
Cells(n, 40) = T
Cells(n, 41) = LL
n = n + 1
End If
End With
End If
Next x
Cells(1, 1).Select
MsgBox "Operazione terminata"
End Sub
questa per il logo, che è quella che hai fatto tu per inserirlo, gli passo solo i parametri che servono per posizionare il logo, la "W" è la lunghezza dell'etichetta che varia per ogni squadra, ed il 3 è lo spazio
Sub Logo(L, T, W, Img)
Dim ind
L = L + W + 3
ind = ActiveWorkbook.Path & "\Immagini\"
ActiveChart.Shapes.AddShape(msoShapeRoundedRectangle, L, T - 8, 20, 20).Select
Selection.ShapeRange.Line.Visible = msoFalse
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture ind & Img
.TextureTile = msoFalse
End With
End Sub
controlla la macro perche quando hai inserito tu la tua macro nel riporto "Collection" lo inseriva come "Collecti0n" con lo zero al posto della "o" forse perche non hai scelto l'opzione giusta per allegare il codice.
per il momento un Saluto, e continuo a vedere se riesco a risolvere, il file lo hai, quindi inutile allegarlo, ma se vuoi lo allego.
Ciao Salvatore (8-D
P.S. comunque vedo che lo ha fatto anche a me modificare la "o" con lo "0"
[Modificato da by sal 23/09/2021 09:48] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 6.522 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
23/09/2021 10:01 | |
Hoops, dimenticavo, mi ha chiesto quando raggiungono le ultime giornate, a quel punto, basta ridurre(accorciare) l'area del grafico in questo modo sono visibili anche se superano l'area del grafico.
credo che basterebbe sapere il Left dell'area del grafico e controllare il Left maggiore nella colonna "AO" ed agire di conseguenza, ma questa è una supposizione, al momento vedrò come comportarmi, perche dovrei anche uniformare il formato del colore del grafico e non com'è adesso che si notano le due aree distinte.
Ciao Salvatore (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 942 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
23/09/2021 10:02 | |
Ciao
Nella macro Togli devi inserire il richiamo ad altra macro che inserire/elimina i loghi.
Ho aggiunto una condizione alla macro e, facendo richiamo alla mia macro che avevo postato per eliminare i loghi, esegue il lavoro.
Onestamente non saprei come agire per "riposizionare" i loghi quando deve inserirli (ho messo uno stop).
Questo il codice (lo inserisco semplicemente senza usare ">")
Sub Togli()
Dim x
For Each x In ActiveSheet.Shapes
If x.Name = "Group 10" And Cells(22, 29) = 0 Then
x.Fill.ForeColor.RGB = RGB(0, 112, 192)
Range("AC2:AC21") = 0
Cells(22, 29) = 1
Exit For
End If
If x.Name = "Group 10" And Cells(22, 29) = 1 Then
x.Fill.ForeColor.RGB = RGB(131, 60, 12)
Range("AC2:AC21") = 1
Cells(22, 29) = 0
Exit For
End If
Next x
'xxxxxxxxxxxxxxxxxxxxxx mia aggiunta
If Cells(22, 29) = 0 Then
Call Elimina_Loghi
ElseIf Cells(22, 29) = 1 Then
Stop
End If
'xxxxxxxxxxxxxxxxxxxxxx fine aggiunta
End Sub
Sub Elimina_Loghi()
Dim i As Long
ActiveSheet.ChartObjects(1).Activate
For i = ActiveChart.Shapes.Count To 1 Step -1
If Left(ActiveChart.Shapes(i).Name, 5) = "Round" Then
ActiveChart.Shapes(i).Delete
End If
Next
End Sub
Fai sapere. Ciao,
Mario |
| | Post: 6.523 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
23/09/2021 10:16 | |
Ciao Mario, si funziona egregiamente, ora credo che dovrò creare una nuova macro Complessa che funzioni singolarmente, cioè gli passerò soltanto il parametro della squadra e mi creerà l'etichetta ed il logo, accodandolo nel caso di pari punteggio.
ma credo che forse dovrò creare nuove colonna di appoggio per il Left temporaneo, ma ci devo pensare, perche credo che bastino quelle.
Ciao Salvatore (8-D
P.S: puoi inserire tranquillamente il codice non lo so perche ma lo fa solamente con la parola "SeriesCollecti0n(d)" forse l'editor la interpreta malamente. [Modificato da by sal 23/09/2021 10:19] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 943 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
23/09/2021 10:29 | |
Ciao
Hai provato la macro che ho detto di aver "ripulito"?
Forse nel resto del lavoro fai riferimento alle posizioni ma io non ho usato alcuna colonna d'appoggio, solo la ricerca del logo della squadra).
Ciao,
Mario |
| | Post: 6.524 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
23/09/2021 10:37 | |
Ciao Si ho provato la tua macro ripulita, ma mi dava problemi con la scrittura del logo, cioè anche se non fai riferimento alle posizioni, non riusciva a prendere bene il left.
perche i comandi dell'etichetta e del marker sono differenti e non potevo prendere il left di uno che andava in conflitto con l'altro non riconoscendo i comandi.
Ciao By Sal (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 6.525 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
23/09/2021 18:58 | |
Ciao Mario con la tua macro che genera il logo, questa
Sub Logo(L, T, W, Img)
Dim ind
L = L + W + 3
ind = ActiveWorkbook.Path & "\Immagini\"
ActiveChart.Shapes.AddShape(msoShapeRoundedRectangle, L, T - 8, 20, 20).Select
ShpL = 'come prendo il nome dello shape appena creato
Selection.ShapeRange.Line.Visible = msoFalse
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture ind & Img
.TextureTile = msoFalse
End With
End Sub
devo inserire il nome dello "shape" appena creato nella variabile pubblica.
in modo da poterlo selezionare direttamente per eliminarlo
Ciao Salvatore (8-D
[Modificato da by sal 23/09/2021 19:00] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 6.526 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
24/09/2021 08:43 | |
Ciao Trovato il metodo,
nel frattempo mi sono accorto anche che gli shape generati vanno in numero incrementale, cioè se cancello i loghi e li inserisco di nuovo se l'ultimo era "RoundedRectangle 20" diventava "21" a seguire e questo alla fine avrò del loghi con numero eccessivo, per cui ho fatto rinominare i Loghi con il numero della serie ed anche cambiando nome in "Shpxx" tutto questo mi rende anche più facile l'individuazione dello Shape per la cancellazione del Singolo ed anche per la creazione o spostamento.
ho anche modificato la macro di cancellazione al posto di "Round" ho inserito "ShP"
Ciao Salvatore (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 944 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
24/09/2021 16:12 | |
Ciao
Anche se superfluo, OTTIMO LAVORO 👍
Ciao,
Mario
|
| | Post: 5 | Registrato il: 07/07/2021
| Età: 44 | Utente Junior | 365 | | OFFLINE | |
|
27/09/2021 10:26 | |
sovrapposizione etichette grafico a dispersioni ciao,
posso chiedervi di ritornare a vedere il post sopra richiamato
https://www.excelacademy.it/supporto/macro-e-vba/vba-per-spostare-etichette-sovrapposte-in-un-grafico-a-dispersione/#post-924
in fondo è rimasto un malfunzionamento da risolvere e che io non riesco data la mia non-conoscenza di VBA.
Grazie in anticipo a chi riesce a trovare tempo e voglia, saluti!
Cesare |
| | Post: 945 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Senior | Excel2019 | | OFFLINE |
|
27/09/2021 14:39 | |
Ciao
Non mi sembra una prassi corretta riferirsi ad altri Forum, ma tant'è.
Ho inserito una nuova macro nella discussione e, come ti ho detto, avresti potuto farlo anche da solo con un po' di iniziativa e tentativi anche senza una approfondita conoscenza di VBA.
Ciao,
Mario |
|
|