05. april 2016 - 13:25Der er
11 kommentarer og 1 løsning
Lav grafer via VBA på flere ark
Hej har brug for en VBA kode, som automatisk laver 3 grafer på ca. 40 forskellige ark I en Excelfil.
Jeg har - ved hjælp af en kørt macro - fundet frem til nedenstående kode, som laver graferne på første ark, hvorefter den stopper her I koden "Range("B5:O8").Select"
Hvad mangler jeg for at den kører alle ark igennem og er det muligt at påsætte en overskrift til hver graf "test1", "test2" og "test3"
og endelig kan graferne placers fra kolonne T og udaf.
på forhånd rigtig mange tak
Sub graf_2()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Afdelinger 2013-2014" And ws.Name <> "Kalender 2016" And ws.Name <> "Data 2013 og 2014" And ws.Name <> "Data 2015" And ws.Name <> "Profiler samlet" And ws.Name <> "Profiler behandlet" And ws.Name <> "OUH profil 2016" Then
Sub graf() Dim ws As Worksheet Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Sheets ws.Select ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=Range("'Ark1'!$B$5:$O$8") ActiveChart.ChartType = xlLine
flytDiagram 3, "T100" Next End Sub Private Sub flytDiagram(nr, plads) With ActiveSheet .ChartObjects(nr).Top = .Range(plads).Top .ChartObjects(nr).Left = .Range(plads).Left End With End Sub
Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Sheets ws.Select ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=Range("'Ark1'!$B$5:$O$8") ActiveChart.ChartType = xlLine
Mange tak for koden - har rodet lidt med den og sat den sammen, som jeg tror den burde se ud, men den virker desværre ikke helt - kan du se, hvad jeg mangler/gør forkert.
på forhånd rigtig mange tak.
Sub graf()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "Afdelinger 2013-2014" And ws.Name <> "Kalender 2016" And ws.Name <> "Data 2013 og 2014" And ws.Name <> "Data 2015" And ws.Name <> "Profiler samlet" And ws.Name <> "Profiler behandlet" And ws.Name <> "OUH profil 2016" Then
Prøv at erstatte placering af diagrammet med samme opsætning - dog således at du retter (1) -> (2) -> (3) Ved de 2 følgende diagrammer Så får du samme virkning som i #1 med benyttelse af Sub FlytDiagram
har siddet og rodet lidt videre og føler jeg er tæt på:-)
Hvis jeg ikke medtager titel og kun kører koden til det første dagram, så virker koden og det første diagram indsættes korrekt på alle ark, men medtager jeg titel på første diagram eller forsøger jeg at danne de 2 andre diagrammer, virker koden ikke
Sub graf()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> "Afdelinger 2013-2014" And ws.Name <> "Kalender 2016" And ws.Name <> "Data 2013 og 2014" And ws.Name <> "Data 2015" And ws.Name <> "Profiler samlet" And ws.Name <> "Profiler behandlet" And ws.Name <> "OUH profil 2016" Then
Sub graf0604() Dim ws As Worksheet Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Sheets
If ws.Name <> "Afdelinger 2013-2014" And ws.Name <> "Kalender 2016" And ws.Name <> "Data 2013 og 2014" And ws.Name <> "Data 2015" And ws.Name <> "Profiler samlet" And ws.Name <> "Profiler behandlet" And ws.Name <> "OUH profil 2016" Then
ActiveSheet.ChartObjects(3).Top = ActiveSheet.Range("T100").Top ActiveSheet.ChartObjects(3).Left = ActiveSheet.Range("AB100").Left '<<<- her manglede "" omkring AB100 End If Next Application.ScreenUpdating = True End Sub
så virker den - rettede fejlen og lavende en lille ekstra ændring - se nedenfor
mange tak for hjælpen - det var super - hvis du sender et svar,. så overfører jeg pointene
graf0604() Dim ws As Worksheet Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Sheets
If ws.Name <> "Afdelinger 2013-2014" And ws.Name <> "Kalender 2016" And ws.Name <> "Data 2013 og 2014" And ws.Name <> "Data 2015" And ws.Name <> "Profiler samlet" And ws.Name <> "Profiler behandlet" And ws.Name <> "OUH profil 2016" Then
ActiveSheet.ChartObjects(3).Top = ActiveSheet.Range("T100").Top ActiveSheet.ChartObjects(3).Left = ActiveSheet.Range("AB100").Left End If Next Application.ScreenUpdating = True End Sub
Selv tak Har lagt svar ind tidligere - men du kan få et til
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
