hat einer von euch schon mal zufällig einen Fragebogen mit Checkboxen erstellt (z.B. Auswahl "trifft voll zu" =1 bis "trifft gar nicht zu"=5).
Und das man alle Fragebögen die sich in einem Ordner befinden dann automatisch über ein Marko auslesen und sich die Werte (Checkbox bei "trifft gar nicht zu" gesetzt =5, sonst "") je Frage ausgeben lassen kann.
Will einem Freund für seine Schulklasse helfen und hatte die Hoffnung das einer von euch etwas ähnliches bereits mal programmiert hat
Erstelle ein xlsx mit den Fragen, aber noch keinen Option-Buttons.
Diese müssen in einer Gruppe angelegt werden (Makro/copy-paste), damit nur eine pro Frage ausgewählt werden kann. Eine sehr ordentliche Vergabe der Namen ist hilreich.
Die Auswertung erfolgt dann über eine xlsm-Datei, die alle ausgefüllten Fragebogen einliest.
mfg
Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:1 Nutzer sagt Danke an Fennek für diesen Beitrag 28 • Käpt'n Blaubär
Datei habe ich als Muster erstellt.
Das mit den Option-Buttons habe ich ehrlich gesagt nicht verstanden. Ich hatte auch welche eingefügt aber dann ist genau das Problem aufgetreten das ich nur einen auswählen konnte, nicht aber wie gewollt: einen pro Zeile
anbei eine xlsx Version mit OptionButtons. Beim Versuch diese gruppierten Buttons zu kopieren, ist XL jedesmal abgestürzt. Bei einer ähnlichen Frage vor Monaten ging es.
Alternativ ginge auch eine xlsm-Version, die normale Buchstaben setzt.
Dies ist der Code, der vor Monaten geklappt hat. Jetzt stürzt xl auch in einem neuen, sonst leeren Sheet ab.
Code:
Sub Anlegen()
Dim WS As Worksheet: Set WS = ActiveSheet
Dim OpB As OptionButton
Dim c As Range
WS.OptionButtons.Delete
WS.Shapes.SelectAll
Selection.Delete
Set c = Range("E5")
c.Select
Set OpB = WS.OptionButtons.Add(c.Left, c.Top, 20, 20)
With OpB
.Value = xlOff
.Caption = ""
'.LinkedCell = "A5"
'.Characters.Text = "QWE"
.Display3DShading = True
Debug.Print .BottomRightCell.Address, .TopLeftCell.Address, .Top, .Left
End With
'6 Opt anlegen
OpB.Copy
For i = 2 To 6
ActiveSheet.Paste
Next i
'Align
ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.Align msoAlignTops, msoFalse
' Gruppe_dublizieren()
With ActiveSheet
.Shapes(1).Copy
For i = 1 To 10
.Paste
Next i
End With
End Sub
Sub Groups_plazieren()
Dim WS As Worksheet: Set WS = ActiveSheet
With WS.Shapes
For i = 1 To .Count
Debug.Print .Item(i).Name, .Item(i).Left, .Item(i).Top
.Item(i).Left = Cells(5 + i, 6).Left
.Item(i).Top = Cells(5 + i, 6).Top - 3
Next i
End With
End Sub
Sub Del()
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub
'Gruppen-Rahmen mit OptionsButton groupieren und mit copy/paste vervielfältigen
'######### Werte setzen und Auslesen
Sub T_3()
Dim WS As Worksheet: Set WS = ActiveSheet
Dim Shp As Shape
For Each Shp In WS.Shapes
Debug.Print Shp.Name, Shp.GroupItems(1).Name, Shp.TopLeftCell.Row
For i = 1 To Shp.GroupItems.Count
Debug.Print Shp.GroupItems(i).Name
If InStr(1, Shp.GroupItems(i).Name, "Group") > 0 Then
ActiveSheet.Shapes.Range(Array(Shp.GroupItems(i).Name)).Select
Selection.Characters.Text = "Group B" & Shp.TopLeftCell.Row
Shp.GroupItems(i).Visible = msoFalse
End If
If InStr(1, Shp.GroupItems(i).Name, "Option") > 0 Then
Z = Z + 1
'########## Text setzen
Shp.GroupItems(i).AlternativeText = Z
Debug.Print , Shp.GroupItems(i).Name, _
Shp.GroupItems(i).ControlFormat.Value, Shp.GroupItems(i).AlternativeText
End If
Next i
Z = 0
Next Shp
End Sub
############### Scala simple #############
'Spalten D:I für die Scala
'Auswahl mit jeder Taste
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("D:I")) Is Nothing Then
With Target
Die Option-Buttons lassen sich schon gut auswählen, vielen Dank schon dafür!!
wie kann ich die Buttons jetzt noch richtig nummerieren? & die Auswertung verstehe ich gar nicht
Die Idee ist nach Erstellung des Fragebogens OHNE FEHLER alle Optionbuttons anzulegen. Damit ist die Zuordnung der Nr des Optionsbuttons zur einer Frage recht einfach.
Wenn XL abstürzen sollte und die Buttons "chaotische" Nummers erhaten, kann man auch die Position des Rahmens abfragen, da muss aber jeder Rahmen sorgfältig positioniert sein.
Der Code für die Auswertung liest alle Optionbuttons und liefert eine "1" für den ausgewählten Button. Zuammen mit dem Namen dieses Buttons ergibt das die Antwort für jede Frage. Allerdings solltest Du den Code nachvollziehen können, damit Du nicht von einem Forum abhängig bist.
Falls xl wieder abstürzen sollte, ist es viel einfacher mit Textzeichen in Zellen zu lösen, aber die Steuerung erfolgt dann mit Makros während des Ausfüllens. Aus Sicherheitsgründen sollten die Respondents aber eine makrofreie Datei erhalten.
Vorschlag: Nachdem alle Fragen vorliegen kopierst Du EINEN Block mit den Optionsbuttons in diese Datei. Dann sollte die Nummerierung wieder bei 1 beginnen..
nachdem ich den Eingangspost gelesen hatte, gab es für mich zunächst mal eine ganz einfache Lösung.
Als ich dann Deine Antwort gelesen hatte, habe ich gedacht, warum schlägt er zwei Dateien vor? Nachdem
ich dann den Eingangspost gelesen hatte, wußte ich das dann auch :19:
Es ist in diesem Fall eine verdammt schmerzfreie Lösung. Danke dafür.
________________________________________________________________________
wer aufgibt, ohne es versucht zu haben, gibt einfach nur auf!
der Fragebogen kann mit den Platzhaltern (Frage 1 bis x) als abgeschlossen bewertet werden. Mehr Fragen werden es seiner Aussage nicht mehr werden.
Also könnte man theoretisch mit der Datei auch weiter arbeiten..
Ich komme mir wirklich dumm vor (habe gegoogelt und probiert..) ich verstehe nicht wie ich die Nummer der OptionButtons einsehen kann..
Und @ Käpt´n Blaubär: Ich dachte (in meinem begrenzten Kosmos) das ich für die Auswertung aller zurück kommenden Fragebogen auf jeden Fall eine separate Datei brauche die mir die ausgefüllten Bögen auslesen kann. Wenn dem nicht so ist muss das natürlich keine Anforderung sein.
Wie auch immer, ich danke für Eure Hilfe und bin dankbar für jeden für mich verständlichen Tipp
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
