[vba excel] ridimensionamento grafici

[john_revelator]

Buongiorno a tutti. Espongo rapidamente il mio problema. A partire da un'origine dati di access genero una serie di query ed esporto tali valori in tanti singoli fogli di excel. Uso questi valori come origine dei grafici che vado a creare. Il problema consiste nel fatto che solitamente i grafici (dei semplici istogrammi) vengono ridimensionati correttamente ma a volte capita che mi appaiano tante linee nere sovrapposte. Ho provato a capirci qualcosa tramite la registrazione di una macro e mi è sembrato di capire che debba andare ad agire sull'oggetto shape ma non saprei esattamente come. La domanda in sintesi è: come faccio a dimensionare i grafici in maniera corretta? Ciao e grazie.

[MarcoGG]

Ma anche il grafico lo generi on the fly tramite VBA, o aggiorni i valori di grafici preesistenti ?
Magari posta il codice che usi per generare i grafici...

[john_revelator]

Ciao Marco.
Innanzitutto grazie per la tua consueta gentilezza.
Sì, anche i grafici li genero tramite vba (o almeno ci provo )
Scusa se il codice è un pò lungo ma ho già eliminato tutto il superfluo, tipo bordi dalla tabella dati eccetera.

Private Sub cmdStatistiche_Click()

'On Error Resume Next

Dim dbs As Database
Dim strSQL As String
Dim strQueryName As String
Dim qryDef As QueryDef
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim objRST, objRST2, objRST3, objRST4, objRST5, objRST6, objRST7, objRST8, objRST9, objRST10, objRST11 As Recordset
Dim xlchart As Excel.Chart

'********************************************* Inizio foglio stato civile *************************************************************
If cmbCentro = "Complessivi" Or cmbCentro = "" Or IsNull(cmbCentro) Then
centroSQL = ""
Else
centroSQL = " where centro = " & Chr$(34) & cmbCentro & Chr$(34)
End If

strSQL = "SELECT utenti.stato_civile as [Stato civile],Sum(IIf(utenti.sesso='f',1,0)) AS Donne, Sum(IIf(utenti.sesso='m',1,0)) AS Uomini FROM utenti"
strSQL = strSQL & centroSQL & " GROUP BY utenti.stato_civile"
strQueryName = "Statistiche_stato_civile"

For Each qryDef In CurrentDb.QueryDefs
If qryDef.Name = strQueryName Then CurrentDb.QueryDefs.Delete (strQueryName)
Next

Set qryDef = CurrentDb.CreateQueryDef(strQueryName, strSQL)
Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)

Record = objRST.RecordCount

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add

Set xlSheet = xlWorkbook.Sheets(1)

xlSheet.Cells(2, 2).Value = "Donne"
xlSheet.Cells(2, 3).Value = "Uomini"
xlSheet.Cells(2, 4).Value = "Totale"
    
With xlSheet
    .Range("A3").CopyFromRecordset objRST
    .Name = "Stato civile"
End With


xlSheet.Cells(3, 4).Formula = "=Sum(b3:c3)"
xlSheet.Cells(4, 4).Formula = "=Sum(b4:c4)"
xlSheet.Cells(5, 4).Formula = "=Sum(b5:c5)"
xlSheet.Cells(6, 4).Formula = "=Sum(b6:c6)"
xlSheet.Cells(7, 4).Formula = "=Sum(b7:c7)"
xlSheet.Cells(8, 4).Formula = "=Sum(b8:c8)"
xlSheet.Cells(9, 1).Value = "Totali"
xlSheet.Cells(9, 1).Font.Bold = True
xlSheet.Cells(9, 2).Formula = "=sum(b3:b8)"
xlSheet.Cells(9, 3).Formula = "=sum(c3:c8)"
xlSheet.Cells(9, 4).Formula = "=sum(d3:d8)"


'conto il numero totale dei record
Record = objRST.RecordCount

xlSheet.Range("a:a").Columns.AutoFit

ultimariga = xlSheet.UsedRange.Rows.Count
  
  
    Set xlchart = xlApp.Charts.Add
    With xlchart
        .ChartType = xlBarClustered
        .SetSourceData Source:=xlSheet.Range("A2:C" & ultimariga), _
         PlotBy:=xlColumns
        .Location WHERE:=xlLocationAsObject, Name:="Stato civile"
      
      
      With xlWorkbook.ActiveChart
            .HasTitle = True
            .ChartTitle.Characters.Text = "Utenti per stato civile"
            .Axes(xlCategory, xlPrimary).HasTitle = False
            .Axes(xlValue, xlPrimary).HasTitle = False
            .ApplyDataLabels AutoText:=True, LegendKey:=False, _
             HasLeaderLines:=False, ShowSeriesName:=False, ShowCategoryName:=False, _
             ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False
         
       For Each s In .SeriesCollection
        s.DataLabels.NumberFormat = "*??"
       Next
       
          
       End With
    End With
    
xlWorkbook.ActiveChart.SeriesCollection(1).Interior.ColorIndex = 22
xlWorkbook.ActiveChart.SeriesCollection(2).Interior.ColorIndex = 32

xlSheet.ChartObjects(1).Left = xlSheet.Columns(2).Left
xlSheet.ChartObjects(1).Top = xlSheet.Rows(20).Top

'********************************************* Fine foglio stato civile *************************************************************

' Libero le risorse
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

End Sub

Qui puoi vedere cosa succede. La prima è relativa al grafico come esce di consueto, la seconda a come appare qualche volta. Addirittura capita sporadicamente che le linee siano pure più fini.

http://img148.imageshack.us/my.php?i...orrettaji0.jpg
http://img148.imageshack.us/my.php?i...tociatoqg2.jpg

Grazie fin da ora.

[MarcoGG]

La cosa che ha meno impatto sul codice che hai già scritto, è probabilmente questa : prova ad accodare questo codice alla creazione di ogni chart.

In pratica così facendo forzi Excel a spostare / ridimensionare il "contenitore" del tuo chart.
Tutti i controlli-figlio dovrebbero risultare ridimensionati di conseguenza...

    With ActiveChart.Parent
        'IN PIXELS :
        .Left = 50
        .Width = 400
        .Top = 50
        .Height = 300
    End With

Prova con i tuoi valori desiderati.

[john_revelator]

Grazie Marco. Sembra funzionare molto bene. Ho eliminato top e left perchè la posizione del grafico la definisco in termini assoluti con queste due righe

xlSheet.ChartObjects(1).Left = xlSheet.Columns(2).Left
xlSheet.ChartObjects(1).Top = xlSheet.Rows(20).Top

Gentilissimo e risolutivo come sempre.

[MarcoGG]

Originariamente inviato da john_revelator

Ho eliminato top e left perchè la posizione del grafico la definisco in termini assoluti con queste due righe

xlSheet.ChartObjects(1).Left = xlSheet.Columns(2).Left
xlSheet.ChartObjects(1).Top = xlSheet.Rows(20).Top

Considera però che in questo modo non definisci la posizione assoluta, ma bensì relativa, ossia dipendente dalla posizione della Row 20, e della Column 2 ( Colonna B ), e dipendente inoltre dalla dimensione di tutte le righe / colonne precedenti ( se ad esempio, nel tuo caso allarghi la colonna A, il tuo chart verrà spostato a destra... ).
Perciò se è proprio quello che vuoi ottenere, ok, altrimenti col mio metodo definisci tutto in via assoluta in pixel ( l'origine, come per qualsiasi controllo Visual Basic, VBA, VB.NET ) è il primo pixel in alto a sinistra ( angolo alto-sinistro cella A1 ).

[john_revelator]

Ho capito. Grazie.
La posizione del grafico non ha molta importanza, basta che non mi si vada a sovrapporre alla tabella dei dati da cui ha origine.

Il mio scopo finale una volta generati tutti i grafici sarà quello di generare un documento di word in cui andrò ad importare le varie tabelle con i relativi fogli, inserendo un'interruzione di pagina dopo ogni grafico. Una volta che avrò scritto il codice relativo ai grafici vedrò di risolvere anche quel problema (e nel caso tornerò a chiedere lumi a voi).
Ciao Marco e grazie ancora di tutto.

[john_revelator]

Come temevo devo di nuovo rompervi le scatole.
Ho scritto questo codice. Ciò che vorrei è che nel documento di word venga inserito in ciascuna pagina la tabella dati da cui il grafico trae origine, una riga vuota, il grafico relativo, infine un'interruzione di pagina e così via per ciascun foglio.
Nel mio file di excel ho 11 fogli. Ciò che invece ottengo è che mi vengano copiate 10 origini dati (nell'ordine giusto esclusa la prima che non so perchè non appaia), e solo alla fine compaiono tutti i grafici uno per pagina. Potreste aiutarmi ad invididuare i miei errori? Grazie e buon fine settimana.

Dim wdApp As Word.Application
   Dim wdDoc As Word.Document
   Dim wdRange As Word.Range
   Dim sh As Excel.Shape
   Dim icount As Integer

   Set wdApp = CreateObject("Word.Application")
   wdApp.Visible = True
   Set wdDoc = wdApp.Documents.Add
   Set wdRange = wdDoc.Range

   For Each xlSheet In xlWorkbook.Worksheets
      xlSheet.UsedRange.Copy
      wdApp.Selection.Paste
      wdApp.Selection.TypeParagraph
      For Each sh In xlSheet.Shapes
         If sh.Type = 3 Then
            sh.CopyPicture
            If icount > 0 Then
               wdRange.Collapse Direction:=wdCollapseEnd
               wdRange.InsertBreak Type:=wdPageBreak
            End If
            wdRange.Paste
            icount = icount + 1
         End If
      Next
   Next
   
   For Each xlchart In xlWorkbook.Charts
      xlchart.CopyPicture
      If icount > 0 Then
         wdRange.Collapse Direction:=wdCollapseEnd
         wdRange.InsertBreak Type:=wdPageBreak
      End If
      wdRange.Paste
      icount = icount + 1
   Next
   
   wdRange.Collapse Direction:=wdCollapseEnd
   If icount > 0 Then
      MsgBox icount & " grafici sono stati copiati in Word."
      wdApp.Activate
   Else
      MsgBox "Non è stato trovato alcun grafico."
      wdDoc.Close False
      wdApp.Quit
   End If

[MarcoGG]

Originariamente inviato da john_revelator

Ho scritto questo codice. Ciò che vorrei è che nel documento di word venga inserito in ciascuna pagina la tabella dati da cui il grafico trae origine, una riga vuota, il grafico relativo, infine un'interruzione di pagina e così via per ciascun foglio.

Ma lavori all' U.C.A.S ?

Scherzi a parte, il tuo codice mi sembra decisamente prolisso per quel poco che deve fare...
In particolare l'errore di mettere tutti grafici alla fine è dovuto al fatto che usi ben 3 cicli For Each ! Quello interno al primo viene ignorato, probabilmente perchè hai usato l'oggetto wdRange che è inutile e potenzialmente dannoso. Il secondo For Each invece funziona e infatti ti sbatte i grafici alla fine...

Fossi in te cestinerei quel codice del tutto.
Potresti semplificare drasticamente l'operazione semplicemente predisponendo ogni foglio Excel in modo da includere [ origine-dati / spazio / chart ] in un solo e contiguo range selezionabile, poi ...

Public Sub ESPORTA()

   Dim wdApp As Word.Application
   Dim wdDoc As Word.Document
   Dim Foglio As Worksheet
 
   Set wdApp = CreateObject("Word.Application")
   wdApp.Visible = True
   Set wdDoc = wdApp.Documents.Add

   For Each Foglio In ThisWorkbook.Sheets
      Foglio.Select
      Range("A1:H23").Select
      Selection.Copy
      wdApp.Selection.Paste
      wdApp.Selection.InsertBreak Type:=wdPageBreak
      Range("A1").Select
      Application.CutCopyMode = False
   Next
   
   wdApp.Activate
'   wdDoc.Close False
'   wdApp.Quit

End Sub

Fammi sapere...

[john_revelator]

Grazie per l'aiuto.
Purtroppo non riesco a far funzionare il tuo codice.
Mi viene restituito un errore di run-time 4605. Il metodo o la proprietà non è disponibile perchè non c'è testo selezionato in corrispondenza della riga selection.copy.
Preciso che l'intervallo di celle da copiare non è sempre lo stesso per ciascun foglio ma cambia sia il numero di righe che di colonne.

[MarcoGG]

Originariamente inviato da john_revelator

Grazie per l'aiuto.
Purtroppo non riesco a far funzionare il tuo codice.
Mi viene restituito un errore di run-time 4605. Il metodo o la proprietà non è disponibile perchè non c'è testo selezionato in corrispondenza della riga selection.copy.
Preciso che l'intervallo di celle da copiare non è sempre lo stesso per ciascun foglio ma cambia sia il numero di righe che di colonne.

Infatti. E' proprio questo il problema.
Non avendo strutturato i tuoi fogli Excel in modo da semplificarti le cose in fase di esportazione, sei poi costretto a fare salti mortali con VBA...

La riga Range("A1:H23").Select nel mio codice ovviamente va modificata con il tuo range.

- Se riesci cerca di far rientrare tutti i contenuti dei fogli in uno stesso range di riferimento e solo DOPO averlo fatto, prova il mio codice.

- Se ciò risulta impossibile per varie ragioni... Forse hai ancora una possibilità usando i "Named Ranges", ma è tutto da provare...

Io, quando so che l'applicativo VBA deve esportare su Word, creo dei fogli di esportazione su Excel, e faccio in modo di organizzare tutti i contenuti di un Foglio in un'area A4...

[john_revelator]

Ok, faccio subito delle prove. Grazie Marco.

[john_revelator]

Rieccomi.
Purtroppo il metodo di selezionare uno stesso intervallo per tutti i fogli non lo posso applicare perchè di alcune query non posso sapere a priori la lunghezza e col passare del tempo sono destinate a restituire un elenco sempre più lungo di valori. Poichè comunque l'istruzione

xlSheet.UsedRange.Copy

funziona e mi restituisce per ciascun foglio il range corretto immagino sia possibile inserire in word tale range, una riga vuota, il grafico relativo e quindi un'interruzione di pagina.

La cosa che più si avvicina al mio scopo è quella che ho scritto qua sotto ma purtroppo mi inserisce un'interruzione di pagina dopo ogni intervallo di valori e dopo ogni grafico, una pagina vuota alla fine e in corrispondenza della prima pagina appare il grafico ma non i valori. In sintesi un disastro.

For Each xlSheet In xlWorkbook.Worksheets
      
   xlSheet.UsedRange.Copy
   wdRange.Paste
   wdApp.Selection.TypeParagraph
 
      For Each sh In xlSheet.Shapes
      'If sh.Type = msoChart Then
        If sh.Type = 3 Then
           sh.CopyPicture
            If iCount > 0 Then
               wdRange.Collapse Direction:=wdCollapseEnd
               wdRange.InsertBreak Type:=wdPageBreak
            End If
            wdRange.Paste
            iCount = iCount + 1
         End If
     Next
   wdRange.Collapse Direction:=wdCollapseEnd
   wdRange.InsertBreak Type:=wdPageBreak
   Next

[MarcoGG]

Ok. L'origine dati prende i record dal DB, quindi non puoi sapere a priori quanti saranno. Fin qui non ci piove, però :

1. I CAMPI, ossia le colonne sono sempre quelli, no ?

2. La dimensione dei charts, come già visto in precedenza, è uguale in tutti i fogli.

3. Non dovrebbe essere difficile, per ogni foglio, mettere prima la tabella-dati, poi una riga vuota, poi il grafico.

Se le risposte ai punti 1,2,3, sono positive, puoi farcela con una piccola modifica al mio codice del post #9.

[john_revelator]

Grazie per la pazienza. I grafici non hanno tutti le stesse dimensioni.
Ho un dubbio in merito. Ad esempio ho una tabella che suddivide i miei utenti per nazionalità.

Le colonne saranno sempre le stesse (nazione e numero utenti) ma ovviamente il numero di righe cambierà. Poichè fondamentalmente questo è il foglio più lungo, dovrei in pratica selezionare il range di cui fare copia incolla dentro word tenendo conto di questo. Ad esempio, supponendo che io mi ritrovi utenti di 50 nazioni dovrei posizionare il mio grafico a partire dalla riga 52 e dovrei selezionare un range così ampio anche per fogli che in realtà richiedono molto meno spazio. E' così o sbaglio?

Comunque, a parte gli ovvii errori nel mio codice, è così peregrina l'idea di inserire il range e dopo il grafico relativo?

[MarcoGG]

Originariamente inviato da john_revelator

Grazie per la pazienza. I grafici non hanno tutti le stesse dimensioni.
Ho un dubbio in merito. Ad esempio ho una tabella che suddivide i miei utenti per nazionalità.

Le colonne saranno sempre le stesse (nazione e numero utenti) ma ovviamente il numero di righe cambierà. Poichè fondamentalmente questo è il foglio più lungo, dovrei in pratica selezionare il range di cui fare copia incolla dentro word tenendo conto di questo. Ad esempio, supponendo che io mi ritrovi utenti di 50 nazioni dovrei posizionare il mio grafico a partire dalla riga 52 e dovrei selezionare un range così ampio anche per fogli che in realtà richiedono molto meno spazio. E' così o sbaglio?

Comunque, a parte gli ovvii errori nel mio codice, è così peregrina l'idea di inserire il range e dopo il grafico relativo?

Se il range-dati e i grafici cambiano di dimensioni in modo così evidente, come fai a prevedere che ogni coppia tabella-dati+chart occuperà un A4 ?
Questi sono problemi da risolvere prima di scrivere codice, non dopo.

La tua idea non è affatto peregrina, si può provare ( ti posto il codice appena ho tempo )... Ma alla fine non avrai comunque la garanzia che una tabella dati enorme con relativo grafico stia all'interno di un doc. A4...

[john_revelator]

Sono certo che tutti gli intervalli di valori e i relativi grafici stiano all'interno di un foglio a4. L'unico foglio in cui in effetti potrebbe sorgere tale problema è quello relativo alle nazioni. In questo caso non ci sarebbe alcun problema anche se fossero necessarie due pagine di a4, una per i dati e una per il grafico.

[MarcoGG]

Rieccomi qua ( ho avuto parecchio da fare... ).
Soluzione al problema ok. Il seguente codice ( modifica del mio precedente ) dovrebbe essere l'esatta risposta al quesito. L'unico "neo" è una certa quale "laboriosità" nell'esecuzione, una certa lentezza che al momento non mi spiego...

In ogni caso risolve il problema alla grande,
e pochi secondi di attesa in più non credo siano la fine del mondo... :

Public Sub ESPORTA()

   Dim wdApp As Word.Application
   Dim wdDoc As Word.Document
   Dim Foglio As Worksheet
   Dim numFoglio As Integer
   numFoglio = 0
   Dim numFogli As Integer
   numFogli = ThisWorkbook.Sheets.Count
   
   Set wdApp = CreateObject("Word.Application")
   wdApp.Visible = True
   Set wdDoc = wdApp.Documents.Add
   
   For Each Foglio In ThisWorkbook.Sheets
   
      numFoglio = numFoglio + 1
      Foglio.Select
      Foglio.UsedRange.Select
      Selection.Copy
      wdApp.Selection.Paste
      wdApp.Selection.TypeParagraph
      
      Foglio.ChartObjects(1).Activate
      ActiveChart.ChartArea.Copy
      wdApp.Selection.Paste
      If numFoglio <> numFogli Then
        wdApp.Selection.InsertBreak Type:=wdPageBreak
      End If
 
      Range("A1").Select
      Application.CutCopyMode = False
      
   Next
   
   wdApp.Activate
'  wdDoc.SaveAs ...
'  wdDoc.Close False
'  wdApp.Quit

End Sub

Prova...

[john_revelator]

Marco, non ho veramente parole per ringraziarti. Funziona che è una meraviglia.
Nonostante i tuoi impegni il fatto che tu sia sempre così disponibile nell'aiutarmi mi commuove. Non immagini quanto mi hai reso felice. A buon rendere. Grazie ancora infinitamente e complimenti.

P.S. Mi potresti spiegare questa riga

Range("A1").Select

alla fine della routine? L'istruzione in sè la capisco ma non mi è chiaro a cosa serva.

[MarcoGG]

Non è il caso di commuoversi.
Questo Forum è una discreta "vetrina" in cui chiunque può dimostrare le proprie capacità.
Almeno io la vedo così, in attesa di creare il mio Forum / Blog personale ( un progettino a cui sto pensando da tempo... ).

Il codice :

      Range("A1").Select
      Application.CutCopyMode = False

serve allo scopo di anullare la selezione di copia su Excel, una volta tornati indietro, dopo l'esportazione. In pratica emula il doppio click del mouse nella cella A1.