Macro per grafici da posizionare nel foglio

[stevetriple]

Ciao a tutti. Spero possiate aiutarmi con questa macro excel 2007!

Ho aperto un topic qualche giorno fa, ma le cose nel frattempo sono cambiate e devo praticamente cambiare tutto il codice.

Vi spiego: ho una cartella locale con all'interno svariati file *.txt. Devo importarli all'interno di un unico foglio excel, dalla cella AA1 in poi (quindi in una zona più a destra del foglio). Ogni file contiene tre colonne di dati, "ORA", "%OCCUPATO" e "%LIBERO".

Una volta importati i file devo creare per ognuno, sempre sullo stesso foglio o creando un solo foglio aggiuntivo, i grafici corrispondenti e devo (non so come) posizionare i grafici in ordine nel foglio, il primo in alto a sinistra, a fianco il secondo e poi via via sotto tutti gli altri.

HELP!!!

Grazie!

[stevetriple]

Nessuno???

[ricky53]

Ciao,
hai già fatto qualcosa per importare i vari file nel tuo "FOGLIO" ?

Cercando nel forum o in rete troverai degli esempi si cui lavorare ... fatti sentire con del codice sul quale agire

[Anthony47]

Da quello che ho visto nell' altro topic mi sembri abbastanza espero, per cui mi limito a qualche spunto...
Io farei un foglio campione, in cui posizioni da AA1 in avanti tante serie di dati tipici; "tante serie" quante poi pensi di doverne importare nella peggiore delle ipotesi.
Nella sinistra del foglio ti crei un grafico per ognuna delle serie di dati; lavora in ordine crescente di serie dati, e posiziona i grafici come vuoi che vengano nella visualizzazione effettiva. Prendi nota del nome di ogni grafico.
Fine della prima parte.

A questo punto sviluppati una macro che
-cancella tutta l' area che hai popolato con dati tipici
-cerca il nome del primo file ".txt" e lo importa nella posizione AA1 (suggerisco la Importazione invece che la Query)
-poi inserisci l' importazione in un ciclo che ti consente di importare tutti gli altri file txt a partire da AD1, AG1, etc.

In coda al codice della macro cosi' ottenuta aggiungerai questo loop:

Codice: Seleziona tutto

myBase = "AA1"
For I = 1 To 30    '<<< Ipotesi 30 grafici presenti
    If Range(myBase).Offset(0, (I - 1) * 3).Value <> "" Then
        ActiveSheet.ChartObjects(I).Visible = True
    Else
        ActiveSheet.ChartObjects(I).Visible = False
    End If
Next I

A questo punto la macro e' pronta; la parte da te sviluppata serve a importare le N serie di dati; l' ultima parte controlla se una serie e' presente, se Si rende visibile il suo grafico, se No allora lo nasconde.

Prova e fai sapere dove arrivi; e se non risolvi allora scrivi ancora spiegando dove sei arrivato e dove invece ti sei fermato.

Ciao

[stevetriple]

Da quello che ho visto nell' altro topic mi sembri abbastanza espero, per cui mi limito a qualche spunto...
Io farei un foglio campione, in cui posizioni da AA1 in avanti tante serie di dati tipici; "tante serie" quante poi pensi di doverne importare nella peggiore delle ipotesi.
Nella sinistra del foglio ti crei un grafico per ognuna delle serie di dati; lavora in ordine crescente di serie dati, e posiziona i grafici come vuoi che vengano nella visualizzazione effettiva. Prendi nota del nome di ogni grafico.
Fine della prima parte.

A questo punto sviluppati una macro che
-cancella tutta l' area che hai popolato con dati tipici
-cerca il nome del primo file ".txt" e lo importa nella posizione AA1 (suggerisco la Importazione invece che la Query)
-poi inserisci l' importazione in un ciclo che ti consente di importare tutti gli altri file txt a partire da AD1, AG1, etc.

In coda al codice della macro cosi' ottenuta aggiungerai questo loop:

Codice: Seleziona tutto

myBase = "AA1"
For I = 1 To 30    '<<< Ipotesi 30 grafici presenti
    If Range(myBase).Offset(0, (I - 1) * 3).Value <> "" Then
        ActiveSheet.ChartObjects(I).Visible = True
    Else
        ActiveSheet.ChartObjects(I).Visible = False
    End If
Next I

A questo punto la macro e' pronta; la parte da te sviluppata serve a importare le N serie di dati; l' ultima parte controlla se una serie e' presente, se Si rende visibile il suo grafico, se No allora lo nasconde.

Prova e fai sapere dove arrivi; e se non risolvi allora scrivi ancora spiegando dove sei arrivato e dove invece ti sei fermato.

Ciao

Ciao. Purtroppo sono stato aiutato nell'altro topic, non sono molto esperto!

Ho fatto come mi hai detto, ma ora ho pezzi di codice mischiati e sta diventando un vespaio.

Ti allego il codice, vorrei capire come inserire il loop che mi importa gli altri file nelle celle giuste (AD1, AG1 ecc.). I grafici sono 25.

Codice: Seleziona tutto

Sub prova_graf()
'
' prova_graf Macro
'

'
    'Declare the variables
    Dim strPath As String
    Dim strFile As String
    Dim nomeDisco As String
    Dim connessione As String
    Dim NextRow As Long
    Dim Nrighe As Long
    Dim sNomeFile As String
    Dim savePath As String
   
    'Cancella dati
    Columns("AA:CW").Select
    ActiveWindow.SmallScroll ToRight:=1
    Selection.ClearContents
   
   
    'Specify the path to the folder
    strPath = "C:\Documents and Settings\cte0141\Desktop\dischi\"
    savePath = "C:\Documents and Settings\cte0141\Desktop\"
 
    'Make sure that the path ends in backslash
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
    'Get the first file from the folder
    strFile = Dir(strPath & "*.*", vbNormal)
   
   
    'Loop through each file in the folder
    Do While Len(strFile) > 0
        connessione = "TEXT;" & strPath & strFile
   
    'MsgBox connessione
        nomeDisco = UCase(Left(strFile, InStr(1, strFile, ".", vbTextCompare) - 1))
       
       

       With ActiveSheet.QueryTables.Add(Connection:=connessione, Destination:=Range("$AA$1"))
        .Name = nomeDisco
        .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 = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileFixedColumnWidths = Array(12, 10)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    'Get the next file from the folder
    strFile = Dir
       
    'Save file
    ActiveWorkbook.CheckCompatibility = False
    sNomeFile = Format(Date - 1, "yyyymmdd") & "_Busy_Disk.xls"
    ThisWorkbook.SaveAs Filename:=savePath & sNomeFile, FileFormat:=xlExcel8
 
End Sub


[Anthony47]

Per usare bene il mio tempo ti chiederei di pubblicare il file con il foglio campione, con i grafici gia' impostati, e una decina di file da importare.
Per come allegare un file guarda qui: viewtopic.php?f=26&t=80395

Ciao

[stevetriple]

Grazie mille!

A questo link c'è il file con i grafici (vuoti) e posizionati: http://www.ddlstorage.com/a4xd6coi5xjb/ ... o.xlsx.htm

Le celle in cui verranno importati i dati sono dalla AA1 in poi, senza colonne vuote.

Qui invece una decina di file: http://www.ddlstorage.com/s3x63bewgonn/dischi.zip.htm

[stevetriple]

Ho risolto così ...

Codice: Seleziona tutto

    Sub Crea_Graf()
    '
    ' Crea_Graf Macro
    '

    '
        'Declare the variables
        Dim strPath As String
        Dim strFile As String
        Dim nomeDisco As String
        Dim connessione As String
        Dim NextRow As Long
        Dim Nrighe As Long
        Dim sNomeFile As String
        Dim savePath As String
       
        'Cancella dati
        Columns("AA:CW").Select
        ActiveWindow.SmallScroll ToRight:=1
        Selection.ClearContents
       
       
        'Specify the path to the folder
        strPath = "C:\Documents and Settings\cte0141\Desktop\dischi\"
        savePath = "C:\Documents and Settings\cte0141\Desktop\"
     
        'Make sure that the path ends in backslash
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
       
        'Get the first file from the folder
        strFile = Dir(strPath & "*.*", vbNormal)
       
       
        'Loop through each file in the folder
        nDisco = 1
        Do While Len(strFile) > 0
            connessione = "TEXT;" & strPath & strFile
       
        'MsgBox connessione
            nomeDisco = UCase(Left(strFile, InStr(1, strFile, ".", vbTextCompare) - 1))
           
        With ActiveSheet.QueryTables.Add(Connection:=connessione, Destination:=Range("$AA$1").Cells(1, nDisco))
            .Name = nomeDisco
            .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 = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1)
            .TextFileFixedColumnWidths = Array(12, 10)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        'Get the next file from the folder
        strFile = Dir
            nDisco = nDisco + 3
        Loop
       
        'Posizione iniziale
        Range("A1").Select
       
        'Save file
        ActiveWorkbook.CheckCompatibility = False
        sNomeFile = Format(Date - 1, "yyyymmdd") & "_Busy_Disk.xls"
        ThisWorkbook.SaveAs Filename:=savePath & sNomeFile, FileFormat:=xlExcel8
     
    End Sub

[Anthony47]

Grazie per aver condiviso la tua soluzione.

Alla prossima (sperando di aver piu' tempo da dedicarti)!