Hallo zusammen,
ich würde gerne die Ergebnisse von Fragebögen wie die Grafiken der beigefügten Datei auswerten. Die Rohdatenmatrix ist schon erstellt.
Kann mir hierzu einer sagen, wie ich die Grafiken aus den Daten erstellen kann? Bekomme nur mehrere Balkendiagramme hin und nicht wie das in der Datei.
MFG
S.Tomek
[
attachment=35045]
Hallöchen,
das sind gestapelte Balken. Dazu nimmst Du mehrere Datenreihen, entsprechend der Vorgabe sind es 6
Hallo S.,
falls das nicht klappt mit der Grafik, gäbe es alternativ noch eine VBA-Lösung.
Ich als VBA-Mensch würde mir jetzt einfach pro Balken 6 Textfelder nehmen, entsprechend formatieren, geschickt benennen (z.B. "TF_Bl01_1, TF_Bl01_2
") usw. und mir dann eine Funktion schreiben, die die Daten dort reinschreibt und die Balkenbreiten einstellt.
Anliegend ein einfaches Beispiel, wobei die Balkengrafik einfach an ein Range angedockt wird. Da kann man dann auch noch ein transparentes Rechteck drüberlegen oder was immer man möchte.
Hier auch mal etwas Code als Beispiel dazu, kann man natürlich ausbauen oder anders machen.
Code:
Option Explicit
Sub DiagrammAktualisieren()
SetUmfragediagramm "TF_Bl01_", Range("E5:J5"), Range("E3:J3")
End Sub
Function SetUmfragediagramm(sGrafik As String, rBalken As Range, rData As Range)
Dim oShp As Object, rZelle As Object, i As Integer
Dim Wsh As Worksheet
Dim MaxWertData As Currency, MaxWertBlk As Currency, Pkt As Currency
Dim Links As Currency
Set Wsh = rBalken.Cells(1, 1).Parent 'verwendetes Blatt
'Diagrammbreite ermitteln, passend zum angegebenen Range
For Each rZelle In rBalken
MaxWertBlk = MaxWertBlk + rZelle.WIDTH
Next rZelle
'Hundert Prozentwert der Daten ermitteln
For Each rZelle In rData
MaxWertData = MaxWertData + rZelle.value
Next rZelle
Pkt = MaxWertBlk / MaxWertData 'Pixel je Wert
Links = rBalken.Cells(1, 1).Left 'Linke Balkenposition
For i = 1 To 6
With Wsh.Shapes(sGrafik & i)
.Left = Links 'LinkeKästchenposition
.WIDTH = rData.Cells(1, i).value * Pkt 'Kästchenbreite
.Top = rBalken.Cells(1, 1).Top 'Top-Position an Rangevorgabe
.HEIGHT = rBalken.Cells(1, 1).HEIGHT
.TextFrame2.TextRange.Characters.Text = rData.Cells(1, i).value
Links = Links + .WIDTH 'Nächste Kästchenposition
End With
Next i
End Function
_________________________
viele Grüße aus Freigericht ?
Karl-Heinz
Hallo,
hier noch mal ein optimiertes Update...
Code:
Option Explicit
Sub DiagrammeAktualisieren()
With Sheets("Mitarbeiterauswertung")
SetUmfragediagramm "TF_Bl01_", .Range("D5:M5"), Sheets("Daten").Range("B3:G3")
SetUmfragediagramm "TF_Bl02_", .Range("D7:M7"), Sheets("Daten").Range("B4:G4")
'usw.
End With
End Sub
Function SetUmfragediagramm(sGrafik As String, rDiaRng As Range, rDataRng As Range)
Dim oCellDia As Object, i As Integer
Dim Pix As Currency, Links As Currency
Pix = rDiaRng.Width / WorksheetFunction.Sum(rDataRng) 'Pixel je Wert
Set oCellDia = rDiaRng.Cells(1, 1) 'Erstes, linkes Feld des Diagramms
Links = oCellDia.Left 'Linke Diagrammposition
For i = 1 To 6 'Alle Textboxen durchgehen
With oCellDia.Parent.Shapes(sGrafik & i) 'Textbox ansprechen
.Width = rDataRng.Cells(1, i).Value * Pix 'Textboxbreite
.Left = Links: Links = Links + .Width 'Linke Textboxposition setzen
.Top = oCellDia.Top 'Top-Position an Rangevorgabe
.Height = oCellDia.Height 'Höhe der Textbox
.TextFrame2.TextRange.Characters.Text _
= rDataRng.Cells(1, i).Value 'Text aktualisieren
End With
Next i
End Function
______________________
viele Grüße aus Freigericht
Karl-Heinz