Mittels Kontrollk.kopieren

Computer: Software & Programmierung Office Software
1

Hallo
Ich möchte aus einer Auswahl von Personen die untereinander in Zeilen stehen mittels Kontrollkästchen einige auswählen und dann in einer neuen Datei im gleichen Format unter einander speichern.
Dieses will ich nicht mit Access sondern mit Word oder Exel tun.

2

Hallo Udo

Im folgenden vier Prozesse um diese Aufgabenstellung in Word zu lösen. Die Prozesse 2,3 und 4 sind Ereignisroutinen, welche speziell implementiert werden müssen.

Die erste Prozedur fügt der Auflistung linksbündig CheckBoxes bei. Sie kann in ein gewöhnliches neues Modul eingefügt werden und muss grundsätzlich nur einmal ablaufen.

Der zweite Prozess ist eine Ereignisprozedur und dient dazu, alle Einträge zu wählen (Dies ist als Ergänzung zur Aufgebenstellung gedacht)

Der dritte Prozess ist eine Ereignisprozedur und dient dazu, alle Einträge ab zu wählen (Dies ist als Ergänzung zur Aufgebenstellung gedacht)

Der vierte Prozess ist eine Ereignisprozedur und dient dazu, die Einträge, welche über die Checkboxes gewählt wurden in ein neues Dokument zu kopieren.

So werden die Ereignisprozeduren implementiert:

  1. Mit [Alf + F11] in die VBA Umgebung wechseln

  2. Mit [Strg + R] den Projekt-Explorer anzeigen lassen.

  3. Die Auswahl für das fragliche Dokument bzw. Dokumentenvorlage erweitern

  4. Einen Doppelklick auf den Eintrag ThisDocument ausführen

  5. Die letzten drei Prozesse (Knopf1, Knopf2 und Knopf3) in das leere Fenster kopieren, welches sich aufgetan hat

  6. Dokument bzw. Vorlage speichern

Viel Spass!

Gruss
S. Widmer

Sub KontrollkästchenHinzufügen()
Dim oDoc As Document
Dim oTable As Table
Dim oRange As Range
Set oDoc = ActiveDocument
j = 0
For i = 1 To oDoc.Paragraphs.Count
If oDoc.Paragraphs(i).Range.Text Chr(13) Then
j = j + 1
oDoc.Paragraphs(i).Range.Text = vbTab & oDoc.Paragraphs(i).Range.Text
End If
Next i
oDoc.Range(Start:=oDoc.Paragraphs(1).Range.Start, End:=oDoc.Paragraphs(j).Range.End).Select
Selection.ConvertToTable Separator:=wdSeparateByTabs, AutoFit:=True
Set oTable = oDoc.Tables(1)
Dim oZelle As Cell
i = 0
For Each oZelle In oTable.Columns(1).Cells
i = i + 1
Set Chk = ActiveDocument.InlineShapes.AddOLEControl(ClassType:=„Forms.CheckBox.1“, Range:=oZelle.Range)
With Chk.OLEFormat.Object
.Name = „Chk“ & i
.Width = 20
.Caption = „“
End With
Next
oTable.Columns(1).Width = CentimetersToPoints(0.8)
With Selection
.EndKey unit:=wdStory
.TypeParagraph
Set CB = .InlineShapes.AddOLEControl(ClassType:=„Forms.CommandButton.1“)
With CB.OLEFormat.Object
.Name = „Knopf1“
.Width = 100
.Caption = „Alle wählen“
End With
.EndKey unit:=wdStory
.TypeText Text:=vbTab
Set CB = .InlineShapes.AddOLEControl(ClassType:=„Forms.CommandButton.1“)
With CB.OLEFormat.Object
.Name = „Knopf2“
.Width = 100
.Caption = „Alle abwählen“
End With
.EndKey unit:=wdStory
.TypeText Text:=vbTab
Set CB = .InlineShapes.AddOLEControl(ClassType:=„Forms.CommandButton.1“)
With CB.OLEFormat.Object
.Name = „Knopf3“
.Width = 100
.Caption = „Auswahl annehmen“
End With
End With
End Sub

Private Sub Knopf1_Click()
For Each x In Me.InlineShapes
If Left(x.OLEFormat.Object.Name, 3) = „Chk“ Then
x.OLEFormat.Object.Value = True
End If
Next
End Sub

Private Sub Knopf2_Click()
For Each x In Me.InlineShapes
If Left(x.OLEFormat.Object.Name, 3) = „Chk“ Then
x.OLEFormat.Object.Value = False
End If
Next
End Sub

Private Sub Knopf3_Click()
Dim nDoc As Document
Dim oTable As Table
Set oTable = Me.Tables(1)
ReDim Wahl(Me.InlineShapes.Count) As String
i = 0
For Each x In Me.InlineShapes
If Left(x.OLEFormat.Object.Name, 3) = „Chk“ Then
If x.OLEFormat.Object.Value = True Then
i = i + 1
n = Right(x.OLEFormat.Object.Name, Len(x.OLEFormat.Object.Name) - 3)
Wahl(i) = oTable.Columns(2).Cells(n).Range.Text
End If
End If
Next
AnzWahl = i
If AnzWahl = 0 Then
MsgBox „Es ist nix markiert“
End
End If
Set nDoc = Documents.Add
For i = 1 To AnzWahl
nDoc.Range.InsertAfter Left(Wahl(i), Len(Wahl(i)) - 2) & vbCrLf
Next i
End Sub