La consultazione del forum è libera per tutti.
Per poter porre un quesito è invece necessario essere un utente registrato (clicca qui se non lo sei).
Tutti gli utenti che richiedono un supporto, come da REGOLAMENTO, sono caldamente invitati ad allegare un file di esempio con l'indicazione di quello che si desidera ottenere.
ciao a tutti, sono nuovo del forum e spero di partecipare attivamente.
Per adesso ho una richiesta di aiuto, non sono molto esperto in VBA e vorrei risolvere questo problema (mi hanno detto che è possibile solo facendo una macro).
Allego foglio excel con la prima parte che funzione, cioè macro che mette le etichette (trovato su supporto fi office)
Poi soluzione a mano, cioè cosa dovrebbe fare la macro che ho registrato "sposta_etichette_manualemente".
poi il foglio dove faccio girare
un VBA che ho trovato in giro, ma che non funziona...
Qualcuno riesce ad aiutarmi? grazie
Cesare
Ciao
Nella macro che dovrebbe "spostare" le etichette vi è una riga di codice che impone un raffronto fra i nomi delle serie e SOLO SE SONO DIVERSI esegue lo spostamento.
Quello che tu proponi ha una sola serie e, pertanto, quella macro non può eseguire alcuno spostamento. Al momento sono impegnato e non posso dedicarmici ma devi "estrarre" dalla formula della serie il valore della y e, quando è uguale, eseguire lo spostamento.
T'avverto che non è una ... passeggiata.
Ciao,
Mario
Ciao
Ho visto che utilizzi una macro per popolare il Grafico con le etichette.
Sfrutto la stessa macro per spostare le etichette. Ecco il codice
Sub AttachLabelsToPoints_Bis()
Dim Counter As Integer, ChartName As String, xVals As String
Dim aa As Double, i As Long, j As Long
ActiveSheet.ChartObjects("Grafico 2").Activate
xVals = ActiveChart.SeriesCollection(1).Formula
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
For Counter = 1 To Range(xVals).Cells.Count
ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = _
True
ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = _
Range(xVals).Cells(Counter, 1).Offset(0, -1).Value
Next Counter
'creo una Collection con chiave per i valori di y
Dim oColl As New Collection
For i = 2 To 20
On Error Resume Next
oColl.Add Cells(i, 3).Value, CStr(Cells(i, 3).Value)
On Error GoTo 0
Next i
'sposto le etichette
For i = 1 To oColl.Count
aa = 0
For j = 2 To 20
If oColl(i) = Cells(j, 3).Value Then
ActiveChart.SeriesCollection(1).Points(j - 1).DataLabel.Select
Selection.Top = Selection.Top + aa
aa = aa + 20
End If
Next j
Next i
Cells(1, 1).Select
End Sub
Ovviamente se vuoi le etichette più "ravvicinate" modifica il valore della variabile aa
Fai sapere. Ciao,
Mario
Grazie Mario, funziona!! grazie mille ?
Grazie Mario, funziona!! grazie mille ?
ciao se aumento il numero di etichette, ho modificato
For i = 2 To 100
For j = 2 To 100
e funzione ma si interrompe con debug: bisogna forse mettere un controllo?
grazie ancora
Ciao
Se incrementi fino a 100 ma le celle piene sono 99 va in errore quando crea la Collection.
Devi mettere il numero dell'ultima cella piena (e non ci devono essere celle vuote). Per trovare l'ultima cella piena prova a cercare nel Forum o in rete.
Ciao,
Mario
ciao ho modificato un pò ma ho visto un malfunzionamento che non riesco a correggere:
se prendo questa serie:
facendo la macro il datapoint4 che ha lo stesso valore del datapoint3, ma lo sposta anche se non dovrebbe.
Quindi ci vorrebbe un controllo sulla variabile aa per metterlo a zero se il valore x cambia
con datapoint6 invece lo mette bene: boh!
Grazie Mille!
Ciao
E' sempre opportuno allegare il file che ha il problema. La serie di valori da te indicata e da me copia/incollata non dà alcun problema (almeno credo).
Ciao,
Mario
ciao ecco immagine del grafico:
allego cmq file excel, il foglio é l'ultimo "Foglio prova",
grazie ciao
Cesare
Ciao
La macro in buona sostanza è simile alla precedente ma con qualche piccola variante. Dovrebbe (uso il condizionale ma a me funziona) spostare le etichette quando si sovrappongo. Prova e fai sapere.
Sub AttachLabelsToPoints_Ter()
Dim Counter As Integer, ChartName As String, xVals As String
Dim aa As Double, i As Long, j As Long
ActiveSheet.ChartObjects("Grafico 3").Activate
xVals = ActiveChart.SeriesCollection(1).Formula
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
For Counter = 1 To Range(xVals).Cells.Count
ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = _
True
ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = _
Range(xVals).Cells(Counter, 1).Offset(0, -1).Value
Next Counter
'creo una Collection con chiave per i valori di y
Dim oColl As New Collection
For i = 2 To Range(xVals).Cells.Count
On Error Resume Next
oColl.Add Cells(i, 3).Value, CStr(Cells(i, 3).Value)
On Error GoTo 0
Next i
'sposto le etichette
'For i = 1 To oColl.Count
' aa = 0
' For j = 2 To Range(xVals).Cells.Count
' If oColl(i) = Cells(j, 3).Value Then
' ActiveChart.SeriesCollection(1).Points(j - 1).DataLabel.Select
' Selection.Top = Selection.Top + aa
' aa = aa + 20
' End If
' Next j
'Next i
'nuovo spostamento
For i = 1 To oColl.Count
aa = 15
For j = 2 To Range(xVals).Cells.Count
If oColl(i) = Cells(j, 3).Value Then
ab = ActiveChart.SeriesCollection(1).Points(j - 1).DataLabel.Top
ac = ActiveChart.SeriesCollection(1).Points(j).DataLabel.Top
ad = ActiveChart.SeriesCollection(1).Points(j - 1).DataLabel.Left
ae = ActiveChart.SeriesCollection(1).Points(j).DataLabel.Left
If ab = ac And ad = ae Then
ActiveChart.SeriesCollection(1).Points(j).DataLabel.Select
Selection.Top = Selection.Top + aa
aa = aa + 15
ab = 0: ac = 0: ad = 0: ae = 0
End If
End If
Next j
Next i
Cells(1, 1).Select
End Sub
Tieni presente che la macro è senza alcun dubbio migliorabile. Ciao,
Mario
Grazie Mario, va molto meglio ma ho cambiato valori e non funziona ancora; prova con:
datapoint 4 e 5 restano sovrapposti, ecco immagine dove li ho spostati manualmente:
allego file se hai ancora voglia di pensarci, grazie
Cesare
Ciao
Mi era sfuggita la tua ultima richiesta.
Però, come potrai notare, la macro è quasi la stessa ma cambia il modo di ciclare i punti.
Ho lasciato, premettendo un apostrofo, il codice precedente. La parte che funziona per l'esempio postato è l'ultima parte della macro QUATER.
Ti allego il file. Non pubblico la macro perchè il sistema lo assume come SPAM e non me lo consente.
Fai sapere. Ciao,
Mario
PS - Però un po' d'iniziativa e di tentativi da parte tua non guasterebbero. Scusa la sincerità.
@marius44 grazie
ho modificato per cancellare la disposizione della serie precedente in caso di variazione valori ... fi qui ci arrivo!
allego copia finale, ciao
