• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Kopieren tabbladen inclusief Kleurthema (Grafiek)

Status
Niet open voor verdere reacties.
P

Pieter671

Gebruiker
Lid geworden
26 jun 2015
Berichten
100
In bijgevoegd voorbeeldbestand 'Voorbeeld kleuren.xlxm ' kopieer ik twee tabbladen naar een nieuw werkboek.

Bekijk bijlage Voorbeeld kleuren.xlsm

De kleuren van de grafiek worden echter niet goed gekopieerd.

Ik gebruik kleurthema 'Office 2007-2010'. In het nieuwe bestand, na kopiëren, staat de grafiek in kleurthema op 'Kantoor'


Hoe krijg ik de kleurthema's goed in het nieuwe bestand (Resultaat.xlsx)?
 
Kan je het niet opslaan als JPEG
 
In mijn model wordt de grafiek gemaakt met behulp van verschillende parameter.
Het resultaat (de twee gekopieerde tabbladen) is vervolgens weer input voor een nieuwsspreadsheet, waarin weer andere (nieuwe) dingen gedaan worden met de grafiek.

Een JPG-file maken is dus geen optie.

In het nieuwe spreadsheet wil ik graag hetzelfde kleurthema gebruiken.
Heb inmiddels wat verder gezocht, echter nog niet met het wenste eindresultaat.


Met de macro-recorder krijg ik wel deze code

Code: 
    ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
        "C:\Program Files\Microsoft Office\Document Themes 15\Theme Colors\Office 2007 - 2010.xml" _
        )

Maar deze verwijst naar mijn eigen C-schijf. Als een ander persoon deze macro draait op zijn PC gaat dit mogelijk fout.
Mogelijk dat Excel op een andere locatie geïnstalleerd is.


Dus.. hoe kan je dit in VBA programmeren, zonder verwijzing naar de C-schrijf?


P.S. Ik werk trouwens in Excel2013.
 
Een beetje geduld, er zit zeker iemand op dit forum die dit weet te tackelen.
Ik duim alvast voor u. :)
 
Het lijkt erop dat de kleuren van de SeriesCollection niet goed mee komen. Probeer dit eens:
Code: 
Sub kopieren()
'
' Overzetten twee tabbladen naar en nieuws spreadsheet
'

'
[COLOR="#FF0000"]    Dim ScBrdrCi()
    With Sheets("GRAFIEK").Shapes("Grafiek1").Chart
        For i = 1 To .SeriesCollection.Count
            ReDim Preserve ScBrdrCi(i)
            ScBrdrCi(i) = .SeriesCollection(i).Border.ColorIndex
        Next i
    End With[/COLOR]

    Sheets(Array("GRAFIEK", "DATA")).Select
    Sheets("DATA").Activate
    Sheets(Array("GRAFIEK", "DATA")).Copy
    
[COLOR="#FF0000"]    For i = 1 To UBound(ScBrdrCi)
        ActiveSheet.Shapes("Grafiek1").Chart.SeriesCollection(i).Border.ColorIndex = ScBrdrCi(i)
    Next i[/COLOR]
  
    Application.DisplayAlerts = False
    filenaam = "Resultaat"
    Application.Dialogs(xlDialogSaveAs).Show filenaam
    Application.DisplayAlerts = True
    
    ActiveWindow.Close
      
    
    Sheets("START").Select
    Range("A1").Select

End Sub
 
Laatst bewerkt:
@admoor, bedankt voor de toevoeging aan de macro.

De kleuren van de lijnen zijn goed overgenomen.
Wat mij opvalt is dan de lijnen niet dezelfde dikte hebben.
Origineel 3,5 punten en kopie 3 punten

Ook eventueel punten in de grafiek worden nog niet meegenomen.

Kennelijk luistert het het heel nauw met alle grafiek elementen.
Zie twee extra toegevoegde plaats in eerste tabblad.

Hoe kunnen de kleuren van de punten en ook meegenomen worden?
Idem voor de juiste lijndiktes?

Zie Bekijk bijlage Voorbeeld kleuren versie 2.xlsm


Als ik vervolgens het 'resultaat' open, krijg ik de melding en het verzoek om koppelingen bij te werken.
Worden er door deze toevoegen koppelingen naar het originele bestand gelegd?

Pieter
 
Dat van die dikte viel mij ook op maar als je de waarden bekijkt zijn ze wel gelijk. Geen idee hoe dat op te lossen.
Die code doet niks anders dan de kleuren gelijk zetten en niets met koppelingen naar een ander bestand.

Wat de punten e.d. betreft, kijk naar de code die ik gebruikte, die kan je uitbreiden zoals je maar wilt.
Zelf had ik die SeriesCollection ook nog niet eerder gebruikt, dus ff zoeken ;)
SeriesCollection
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan