Avatar billede blolsen Juniormester
05. april 2016 - 13:25 Der 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


    Range("B5:O8").Select
    ws.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("$B$5:$O$8")

    Range("B52:O55").Select
    ws.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("$B$52:$O$55")


    Range("B100:O103").Select
    ws.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("$B$100:$O$103")



End If

    Next
   
End Sub
Avatar billede supertekst Ekspert
05. april 2016 - 15:29 #1
"Her er noget af det"
Placer koden i ThisWorkbook

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 1, "T5"
     
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("'Ark1'!$B$52:$O$55")
        ActiveChart.ChartType = xlLine
       
        flytDiagram 2, "T52"
       
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("'Ark1'!$B$100:$O$103")
        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
Avatar billede supertekst Ekspert
05. april 2016 - 15:39 #2
og så overskrift

    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
     
        ActiveChart.ChartTitle.Text = "T I T E L"  '<-----
       
        flytDiagram 1, "T5"

o.s.v.
Avatar billede blolsen Juniormester
06. april 2016 - 10:56 #3
Hej Supertekst,

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
   
    ws.Select
       
   
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("$B$5:$O$8")
        ActiveChart.ChartType = xlLine
     
        ActiveChart.ChartTitle.Text = "Stationær Elektiv"
       
        .ChartObjects("Stationær Elektiv").Top = .Range("T6").Top
        .ChartObjects("Stationær Elektiv").Left = .Range(
("AB6").Left
       
       
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("$B$52:$O$55")
        ActiveChart.ChartType = xlLine
     
        ActiveChart.ChartTitle.Text = "Stationær Elektiv"
       
        .ChartObjects("Stationær Elektiv").Top = .Range("T53").Top
        .ChartObjects("Stationær Elektiv").Left = .Range(
("AB53").Left
       
     
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("$B$100:$O$103")
        ActiveChart.ChartType = xlLine
     
        ActiveChart.ChartTitle.Text = "Stationær Elektiv"
       
        .ChartObjects("Stationær Elektiv").Top = .Range("T100").Top
        .ChartObjects("Stationær Elektiv").Left = .Range("AB100").Left
     
   
    End If
   
    Next
            Application.ScreenUpdating = True
   

End Sub
Avatar billede supertekst Ekspert
06. april 2016 - 11:35 #4
Hej blolsen

Selv tak. Hvor går det galt?
Avatar billede blolsen Juniormester
06. april 2016 - 11:53 #5
hej igen  - jeg får meddelelsen

Compile Error: Invalid or unqualified referencen med en markering af "Range" I linien

.ChartObjects("Stationær Elektiv").Top = .Range("T6").Top


vil formode at der ligger en generel fejl, som skal rettes hele vejen ned
Avatar billede supertekst Ekspert
06. april 2016 - 14:17 #6
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

        ActiveSheet.ChartObjects(1).Top = ActiveSheet.Range("T6").Top
        ActiveSheet.ChartObjects(1).Left = ActiveSheet.Range("AB6").Left
Avatar billede blolsen Juniormester
06. april 2016 - 16:42 #7
hej igen,

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
   
        ws.Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("$B$5:$O$8")
        ActiveChart.ChartType = xlLine
        'ActiveChart.ChartTitle.Text = "Stationær Elektiv"
   
     
        ActiveSheet.ChartObjects(1).Top = ActiveSheet.Range("T6").Top
        ActiveSheet.ChartObjects(1).Left = ActiveSheet.Range("AB6").Left
       
       
             
        'ActiveSheet.Shapes.AddChart.Select
        'ActiveChart.SetSourceData Source:=Range("$B$52:$O$55")
        'ActiveChart.ChartType = xlLine
     
        'ActiveChart.ChartTitle.Text = "Stationær Akut"
       
        'ActiveSheet.ChartObjects(2).Top = ActiveSheet.Range("T53").Top
        'ActiveSheet.ChartObjects(2).Left = ActiveSheet.Range("AB53").Left
       
     
      'ActiveSheet.Shapes.AddChart.Select
        'ActiveChart.SetSourceData Source:=Range("$B$100:$O$103")
      'ActiveChart.ChartType = xlLine
     
      ' ActiveChart.ChartTitle.Text = "Ambulant"
       
        'ActiveSheet.ChartObjects(3).Top = ActiveSheet.Range("T100").Top
        'ActiveSheet.ChartObjects(3).Left = ActiveSheet.Range(AB100).Left
     
   
        End If
   
    Next
       
        Application.ScreenUpdating = True
   

End Sub
Avatar billede supertekst Ekspert
06. april 2016 - 18:19 #8
Fat mod - jeg tager en tur til med det - måske først i morgen.
Avatar billede blolsen Juniormester
06. april 2016 - 20:20 #9
Super - mange tak&#128522;
Avatar billede supertekst Ekspert
06. april 2016 - 22:59 #10
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
   
        ws.Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("$B$5:$O$8")
        ActiveChart.ChartType = xlLine
        ActiveChart.ChartTitle.Text = "Stationær Elektiv"
   
        ActiveSheet.ChartObjects(1).Top = ActiveSheet.Range("T6").Top
        ActiveSheet.ChartObjects(1).Left = ActiveSheet.Range("AB6").Left
       
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("$B$52:$O$55")
        ActiveChart.ChartType = xlLine
        ActiveChart.ChartTitle.Text = "Stationær Akut"
       
        ActiveSheet.ChartObjects(2).Top = ActiveSheet.Range("T53").Top
        ActiveSheet.ChartObjects(2).Left = ActiveSheet.Range("AB53").Left
       
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.SetSourceData Source:=Range("$B$100:$O$103")
        ActiveChart.ChartType = xlLine
        ActiveChart.ChartTitle.Text = "Ambulant"
       
        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
Avatar billede blolsen Juniormester
07. april 2016 - 09:31 #11
Hej Supertekst,

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
   
    ws.Select
       
        ws.Range("B5:O8").Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlLine
        ActiveChart.SetSourceData Source:=Range("$B$5:$O$8")
        ActiveChart.SetElement (msoElementChartTitleAboveChart)
        ActiveChart.ChartTitle.Text = "stationær Elektiv"
       
   
        ActiveSheet.ChartObjects(1).Top = ActiveSheet.Range("T6").Top
        ActiveSheet.ChartObjects(1).Left = ActiveSheet.Range("AB6").Left
       
       
        ws.Range("B52:O55").Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlLine
        ActiveChart.SetSourceData Source:=Range("$B$52:$O$55")
        ActiveChart.SetElement (msoElementChartTitleAboveChart)
        ActiveChart.ChartTitle.Text = "stationær Akut"
       
       
        ActiveSheet.ChartObjects(2).Top = ActiveSheet.Range("T53").Top
        ActiveSheet.ChartObjects(2).Left = ActiveSheet.Range("AB53").Left
       
        ws.Range("B100:O103").Select
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlLine
        ActiveChart.SetSourceData Source:=Range("$B$100:$O$103")
        ActiveChart.SetElement (msoElementChartTitleAboveChart)
        ActiveChart.ChartTitle.Text = "stationær Akut"
       
        ActiveSheet.ChartObjects(3).Top = ActiveSheet.Range("T100").Top
        ActiveSheet.ChartObjects(3).Left = ActiveSheet.Range("AB100").Left
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Avatar billede supertekst Ekspert
07. april 2016 - 10:51 #12
Selv tak
Har lagt svar ind tidligere - men du kan få et til
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester