Grafici con VBA

Hai un problema con Excel?

Nuova discussione

Grafici con VBA
di ilFonta data: 23/09/2013 13:29:06
Ho scritto una macro che allego. Questa importa un file di testo e svolge alcuni calcoli e crea grafici. Alla fine (subito prima di End Sub) ho scritto una parte di codice che avrebbe dovuto crearmi un grafico a dispersione utilizzando la colonna A (foglio "statistiche") per le ascisse e la H per le ordinate. Il problema è che invece mi viene creato un grafico con tante serie quanto sono le colonne della tabella nel foglio Statistiche (viene creata quindi anche la serie con le ordinate nella colonna B, C, etc tutte nello stesso grafico.

Ho poi notato che VBA non tiene in considerazione le indicazioni a riguardo delle ascisse e ordinate, quindi:

ActiveChart.SeriesCollection(1).XValues = Range(Cells(2, 1), Cells(10, 1))
ActiveChart.SeriesCollection(1).Values = Range(Cells(2, 8), Cells(10, 8))

queste due righe posso anche toglierle che il risultato non cambia.

Come altra prova ho visto che facendo correre un'altra macro con le sole righe relative al grafico finale
ActiveSheet.Shapes.AddChart(xlXYScatter, _
Left:=600, Top:=50).Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "=""mean(dB)"""
ActiveChart.SeriesCollection(1).XValues = Range(Cells(2, 1), Cells(10, 1))
ActiveChart.SeriesCollection(1).Values = Range(Cells(2, 8), Cells(10, 8))

Viene creato il grafico corretto (cioè con una sola serie.

Grazie per l'aiuto

Sub ISTOGRAMMI_E_STATISTICHE()


'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++ questa macro prende i file di ENVI usciti da EXPORT ROI TO ASCII +++++++++++++++++++++++++++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++




'-----------------------------------------------ISTRUZIONI-------------------------------------------------------
'-----------copiare in colonna i nomi delle ROI a partire dalla casella A2 del FOGLIO1---------------------------
'----------------------------------------------------------------------------------------------------------------




'-----------------------ribattezzo i fogli'------------------------------------------------------------
        Sheets("Foglio2").Select
        Sheets("Foglio2").Name = "istogrammi"
        Sheets("Foglio1").Select
        Sheets("Foglio1").Name = "statistiche"

'-----------------------apertura del fileDialog che ci chiede di inserire il file----------------------
        Dim inputFile As String
        Dim dlgOpen As FileDialog

        Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
                dlgOpen.Filters.Clear
    
        With dlgOpen.Filters.Add("File di testo", "*.txt", 1) 'nel fileDialog viene scritto"File di Testo" e ci si aspetta che sia un ".txt"
        End With
    
        If dlgOpen.Show <> -1 Then
        MsgBox "Non hai selezionato nessun file", vbInformation 'questo è un controllo per essere sicuri che si sia inserito un file

        Else
        
'-----------------------inizia l'importazione sempre dalla casella A1-----------------------------------
        Sheets("istogrammi").Select
        inputFile = dlgOpen.SelectedItems(1)
        With ActiveSheet.QueryTables.Add(Connection:= _
                        "TEXT;" & inputFile, Destination _
                        :=Range("$A$1"))
                        .Name = inputFile
                        .FieldNames = True
                        .RowNumbers = False
                        .FillAdjacentFormulas = False
                        .PreserveFormatting = True
                        .RefreshOnFileOpen = False
                        .RefreshStyle = xlInsertDeleteCells
                        .SavePassword = False
                        .SaveData = True
                        .AdjustColumnWidth = True
                        .RefreshPeriod = 0
                        .TextFilePromptOnRefresh = False
                        .TextFilePlatform = 850
                        .TextFileStartRow = 1
                        .TextFileParseType = xlDelimited
                        .TextFileTextQualifier = xlTextQualifierDoubleQuote
                        .TextFileConsecutiveDelimiter = True
                        .TextFileTabDelimiter = True
                        .TextFileSemicolonDelimiter = False
                        .TextFileCommaDelimiter = False
                        .TextFileSpaceDelimiter = True
                        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
                        .TextFileTrailingMinusNumbers = True
                        .Refresh BackgroundQuery:=False
    End With
End If

'----------------------trattamento dati-----------------------------------------
        
' sostituisce i punti con le virgole
        Cells.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
' eliminazione delle colonne inutili
        Columns("J:K").Select
        Selection.Delete Shift:=xlToLeft

        Columns("A:H").Select
        Selection.Delete Shift:=xlToLeft

' cancella il contenuto di A1
        Cells(1, 1).Select
        Selection.ClearContents

' elimina le righe vuote in alto
        Do
                If (IsEmpty(Cells(1, 1))) Then
                        Cells(1, 1).EntireRow.Delete
                End If
        Loop While IsEmpty(Cells(1, 1))

' sposta colonna A in B
        Columns("A:A").Select
        Selection.Cut Destination:=Columns("B:B")
    
' calcola l'ultima riga
        Dim ultimariga As Integer
        ultimariga = Cells(Rows.Count, 2).End(xlUp).Row

' converte sigma da testo anumero
        Range("C2").Select
        ActiveCell.FormulaR1C1 = "=RC[-1]*1" 'converte in numeri moltiplicando per 1
        Selection.AutoFill Destination:=Range(Cells(2, 3), Cells(ultimariga, 3)), Type:=xlFillDefault
        
        Range(Cells(2, 3), Cells(ultimariga, 3)).Select
        Selection.Copy 'copi e incollo in valori
        Range("D2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        Columns("B:C").Select 'tolgo le colonne in eccesso
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft

' trasforma sigma in dB
        Range("C2").Select
        ActiveCell.FormulaR1C1 = "=10*LOG10(RC[-1])"
        Selection.AutoFill Destination:=Range(Cells(2, 3), Cells(ultimariga, 3)), Type:=xlFillDefault
    
' elimino i #NUM!
        Columns("C").SpecialCells(xlFormulas, xlErrors) _
                .ClearContents

' crea la colonna "A" con le frequenze
        Dim Freq As Double
        Freq = -20
    
        For i = 2 To 100
                Cells(i, 1).Select
                ActiveCell.FormulaR1C1 = Freq
                Freq = Freq + 0.2
        Next

'-------------------------questa parte serve a fare le statistiche nel foglio Statistiche-------------------------
      
' copio la colonna con i nomi delle ROI
    Sheets("statistiche").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("istogrammi").Select
    Columns("D:D").Select
    ActiveSheet.Paste

' -------------------------scrivo l'intestazione nel foglio STATISTICHE-------------------------------------------
    
    Sheets("statistiche").Select
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ROI"
    
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "#"

    Range("C1").Select
    ActiveCell.FormulaR1C1 = "min"
        
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "min dB"
    
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "max"
    
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "max dB"
    
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "mean"
    
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "mean dB"
    
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "stdev"
    
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "stdev dB"
    
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "ENL"

' --------------------------conto il numero di ROI e lo scrivo nel foglio STATISTICHE--------------------------

' conta il numero di righe
    Dim totRighe As Integer
    totRighe = WorksheetFunction.CountA(Range("A2:A100")) 'G100 è stato messo per comodità

' mette il numero alle ROI
    Dim numero As Integer
    Dim riga As Integer

    numero = 1
    riga = 2
    For i = 1 To totRighe
        If Not (IsEmpty(Cells(riga, 1))) Then
            Cells(riga, 2).Select
            ActiveCell.FormulaR1C1 = numero
            numero = numero + 1
            riga = riga + 1
       End If
    Next
    
' -------------------------scrivo l'intestazione nel foglio ISTOGRAMMI--------------------------------------------------
    
    Sheets("istogrammi").Select
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "classi"

    Range("B1").Select
    ActiveCell.FormulaR1C1 = "sigma"

    Range("C1").Select
    ActiveCell.FormulaR1C1 = "sigma (dB)"

    Range("D1").Select
    ActiveCell.FormulaR1C1 = "ROI"

' --------------------------dimensionamento colonne--------------------------

        Dim Colonna(1 To 210) As String 'le colonne sono il doppio perchè vengono sempre create 2 colonne per ogni istogramma
        'p = variabile delle lettere della colonna
        For p = 1 To 26 '26 è il numro di lettere dell'alfabeto
                Colonna(p) = Chr(64 + p) 'Chr65 è l'equivalente del carattere A in ASCII, sto contando le colonne A, B,.... AA, AB
                Colonna(p + 26) = "A" + Chr(64 + p)
                Colonna(p + 52) = "B" + Chr(64 + p)
                Colonna(p + 78) = "C" + Chr(64 + p)
                Colonna(p + 104) = "D" + Chr(64 + p)
                Colonna(p + 130) = "E" + Chr(64 + p)
                Colonna(p + 156) = "F" + Chr(64 + p)
                Colonna(p + 182) = "G" + Chr(64 + p)
        Next

' --------------------------contare ROI--------------------------

        Dim indgroup(1 To 100) As Integer

        numero_ROI = 0 ' vuol dire che parto con 0 ROI
        numero_righe = 2 ' vuol dire che parto dalla riga 2
        If Not (IsEmpty(Cells(2, 3))) Then
    
                indgroup(1) = 2
                numero_ROI = 1 'conteggio le ROI
    
                Do
                numero_righe = numero_righe + 1 'incremento la riga
                        
                        If IsEmpty(Cells(numero_righe, 3)) And Not (IsEmpty(Cells(numero_righe + 1, 3))) Then 'se è piena quella riga ma non quella sotto incremento il numero di ROI
                                numero_ROI = numero_ROI + 1
                                indgroup(numero_ROI) = numero_righe + 1
            End If
                
                Loop Until IsEmpty(Cells(numero_righe + 1, 3)) And IsEmpty(Cells(numero_righe, 3)) ' continuare finchè non ci sono due righe vuote

' --------------------------questa parte serve a fare gli istogrammi nel foglio ISTOGRAMMIe le Statistiche nel foglio STATISTICHE--------------------------
Sheets("istogrammi").Select
        
        Dim righe_stats As Integer
            righe_stats = 2
        
        Dim sigmadB_stat As Range
        Dim sigmaLin As Range

    For t = 1 To numero_ROI '--------------da questo ciclo dipende tutto-------------------
        If t < numero_ROI Then
            
            limSupROI = Str(indgroup(t))
            limSupROI = Right(limSupROI, Len(limSupROI) - 1)
            
            limInfROI = Str(indgroup(t + 1) - 2)
            limInfROI = Right(limInfROI, Len(limInfROI) - 1)
            
        Else
            limSupROI = Str(indgroup(t))
            limSupROI = Right(limSupROI, Len(limSupROI) - 1)
            
            limInfROI = Str(numero_righe - 1)
            limInfROI = Right(limInfROI, Len(limInfROI) - 1)
                       
        End If

            sigma_dB_ord = Colonna(7 + (t - 1) * 2) + "2"
            sigmadB_ist = "C" + limSupROI + ":C" + limInfROI
            Set sigmadB_stat = Range("C" + limSupROI + ":C" + limInfROI)
            Set sigmaLin = Range("B" + limSupROI + ":B" + limInfROI)
            
' --------------------------calcolo statistiche nel foglio statistiche PRIMA PARTE--------------------------
            
            '------ min
            Sheets("statistiche").Select
            Cells(righe_stats, 3) = Evaluate("MIN(istogrammi!" & sigmaLin.Address & ")")
            
            '------ max
            Sheets("statistiche").Select
            Cells(righe_stats, 5) = Evaluate("MAX(istogrammi!" & sigmaLin.Address & ")")
            
            '------ media
            Sheets("statistiche").Select
            Cells(righe_stats, 7) = Evaluate("AVERAGE(istogrammi!" & sigmaLin.Address & ")")

            '------ stdev
            Sheets("statistiche").Select
            Cells(righe_stats, 9) = Evaluate("STDEV(istogrammi!" & sigmaLin.Address & ")")
            
            '------ stdev dB
            Sheets("statistiche").Select
            Cells(righe_stats, 10) = Evaluate("STDEV(istogrammi!" & sigmadB_stat.Address & ")")
            righe_stats = righe_stats + 1

' --------------------------ordinamento dati in frequenze--------------------------
            
            Sheets("istogrammi").Select
            Application.Run "ATPVBAEN.XLAM!Histogram", _
            ActiveSheet.Range(sigmadB_ist), _
            ActiveSheet.Range(sigma_dB_ord), _
            ActiveSheet.Range("A2:A100"), _
                False, False, False, False
            
            '(sigma_dB)= dati di backscattering = nella colonna C
            '(sigma_dB_ord)= colonne dei dati ordinati per istogrammi = nella colonna G
            '(A2:A100)= colonna delle frequenze = nella colonna A

' --------------------------posizionamento dei grafici--------------------------

            x_iniz_graf = 100
            y_iniz_graf = 100
        
            x = (t - 1) Mod 10
            y = Int((t - 1) / 10)
        
               x_iniz_graf = 100 + (x) * 300
            y_iniz_graf = 100 + y * 200
        
' --------------------------calcolo delle colonne dei grafici--------------------------
            
            colon_class_sigma_dB = Colonna(7 + (t - 1) * 2) + "3:" + Colonna(7 + (t - 1) * 2) + "101"
            colon_freq = Colonna(7 + (t - 1) * 2 + 1) + "3:" + Colonna(7 + (t - 1) * 2 + 1) + "101"
            nomi_ROI = "D" + Right(Str(t + 1), Len(Str(t + 1)) - 1)

' --------------------------fare i grafici--------------------------
            
            ActiveSheet.Shapes.AddChart(xlColumnStacked, _
            Left:=x_iniz_graf, Top:=y_iniz_graf, Width:=300, Height:=200).Select
            ActiveChart.ChartType = xlColumnStacked
            ActiveChart.HasTitle = True
            ActiveChart.ChartTitle.Text = ActiveSheet.Range(nomi_ROI)
            ActiveChart.SeriesCollection(1).XValues = ActiveSheet.Range("G3:G101")
            ActiveChart.SeriesCollection(1).Values = ActiveSheet.Range(colon_freq)

    Next

' --------------------------compilazione statistiche nel foglio statistiche SECONDA PARTE--------------------------
            Sheets("statistiche").Select

            '------ min dB
            Range("D2").Select
            ActiveCell.FormulaR1C1 = "=10*LOG10(RC[-1])"
            Selection.AutoFill Destination:=Range(Cells(2, 4), Cells((numero_ROI + 1), 4)), Type:=xlFillDefault
            
            '------ max dB
            Range("F2").Select
            ActiveCell.FormulaR1C1 = "=10*LOG10(RC[-1])"
            Selection.AutoFill Destination:=Range(Cells(2, 6), Cells((numero_ROI + 1), 6)), Type:=xlFillDefault
            
            '------ media dB
            Range("H2").Select
            ActiveCell.FormulaR1C1 = "=10*LOG10(RC[-1])"
            Selection.AutoFill Destination:=Range(Cells(2, 8), Cells((numero_ROI + 1), 8)), Type:=xlFillDefault

            '------ ENL
            Range("K2").Select
            ActiveCell.FormulaR1C1 = "=(RC[-4]^2)/(RC[-2]^2)"
            Selection.AutoFill Destination:=Range(Cells(2, 11), Cells((numero_ROI + 1), 11)), Type:=xlFillDefault

Else
    
    MsgBox ("Inserisci dati")

End If

' ------------------------ grafici nel foglio statistiche------------------------

    'grafico mean dB
    ActiveSheet.Shapes.AddChart(xlXYScatter, _
        Left:=600, Top:=50).Select
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""mean(dB)"""
    ActiveChart.SeriesCollection(1).XValues = Range(Cells(2, 1), Cells(10, 1))
    ActiveChart.SeriesCollection(1).Values = Range(Cells(2, 8), Cells(10, 8))
    

    
End Sub

di Vecchio Frac data: 23/09/2013 13:53:41
Hai inserito il tuo nick nella casella di testo relativa al titolo della discussione. Provvedo alla correzione a meno che non intendessi postare una discussione avendo te stesso come "problema da risolvere" ^_^
Grafici con VBA
di ilFonta (utente non iscritto) data: 23/09/2013 14:40:24
Grazie Vecchio Frac, se osservi come programmo ti accorgi che il mio problema più grave non è il VBA!!!!!
di Grograman (utente non iscritto) data: 23/09/2013 14:44:46
Ciao!

E' possibile vedere il txt che genera i grafici privo di dati sensibili?

Così a spanne non saprei, bisognerebbe fare qualche test!
Grafici con VBA
di ilFonta (utente non iscritto) data: 24/09/2013 14:01:10
Certo.
Ti allego il fille all'interno dello spazio dedicato al VBA, è lunghissimo:
Per far funzionare correttamente la macro devi copiare il nome dei grafici nella colonna A, partendo da A2, nel foglio "Foglio1). Ad esempio puoi copiarci:
t25
t3
t27
t1
t2
t5
t7
t21
t22
t16
t20

Successivamente la macro ti chiede il file TXT che è quello che ti allego.

Grazie
nota: il testo è stato tagliato perchè troppo lungo
di Vecchio Frac data: 24/09/2013 15:41:59
C'è un limite fisico allo spazio riservato al campo TEXT di questo forum, e temo che lo hai superato abbondantemente... allega il file txt alla discussione, che è meglio.
Grafici con VBA
di ilFonta (utente non iscritto) data: 24/09/2013 16:20:26
chiedo scusa, credo di avre allegato correttamente il file. Grazie
di paolomath data: 25/09/2013 08:58:05
Ciao,

per il grafico finale prova così:

Range(Cells(2, 1), Cells(10, 1)).Select
ActiveSheet.Shapes.AddChart(xlXYScatter, _
Left:=600, Top:=50).Select
ActiveChart.SeriesCollection(1).Name = "=""mean(dB)"""
ActiveChart.SeriesCollection(1).XValues = Range(Cells(2, 1), Cells(10, 1))
ActiveChart.SeriesCollection(1).Values = Range(Cells(2, 8), Cells(10, 8))

La versione che hai messo dà dei problemi se hai dei dati sulla colonna 2 in quanto

ActiveSheet.Shapes.AddChart(xlXYScatter, Left:=600, Top:=50).Select

seleziona tutti i dati della tabella.

Bye
Grafici con VBA
di ilFonta (utente non iscritto) data: 25/09/2013 09:51:21
Funziona. Grazie mille per l'aiuto
Ciao
di paolomath data: 25/09/2013 14:04:45
Prego,

funziona anche con:

Range(Cells(2, 1), Cells(10, 1)).Select
ActiveSheet.Shapes.AddChart(xlXYScatter, _
Left:=600, Top:=50).Select
ActiveChart.SeriesCollection(1).Name = "=""mean(dB)"""
ActiveChart.SeriesCollection(1).Values = Range(Cells(2, 8), Cells(10, 8))

che è più pulito.

Bye bye.
Grafici con VBA
di ilFonta (utente non iscritto) data: 25/09/2013 15:53:49
E' vero. Grazie mille

Vuoi Approfondire?