Ahnenforschung Familienblatt

Question

Hallo Ihr Lieben,

Ich bin unter die Ahnenforscher gegangen und habe mir zur Erleichterung eine Eheschliessungstabelle der einzelnen Familien gebastelt.
Nun bräuchte ich Eure Hilfe bei diversen Makros. Ich versuche meine Problemchen so genau wie möglich zu beschreiben.
Die Datei baut sich wie folgt auf:

1. Tabellenblatt = Startseite
auf dieser Seite habe ich einen Button "Neues Familienblatt einfügen" das ich mit diesem Makro gelöst habe

Public Sub Vorlage()

Sheets("Vorlage").Visible = True

Dim strName As String
strName = InputBox("Familie eingeben", "Eingabe", "Familiennamen")
If strName = "" Then Exit Sub
ThisWorkbook.Worksheets("Vorlage").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = strName

Sheets("Vorlage").Visible = False

End Sub

Von Zelle A9 soll nach unten hin immer die laufende Nummer angezeigt werden wenn die Nachbarzelle B9 nach unten hin eine Namenspaarung beinhaltet.

2. Tabellenblatt = Vorlage
Dieses Blatt ist das Grundgerüst für die ganzen Daten, die auch Formeln enthalten um das Alter zu errechnen.
Dieses Tabellenblatt ist ausgeblendet und enthält zwei Buttons "Liste leeren" und "zurück zur Startseite".

So nun meine Probleme oder Wünsche:
Im Tabellenblatt "Vorlage" würde ich noch gerne eine Makro "Speichern" einbauen, was mir nur das Aktive Tabellenblatt unter den Namen die in Zelle C1 und E1 stehen, unter M:\BackUp_Eigene Dateien\Ahnenforschung als Einzeldatei abspeichert. Bsp.: Speicherort\GeburtsnameA - GeburtsnameB.
Gespeichert werden soll dann dieses Blatt mit Formeln, aber ohne Module, Buttons und Makros.

Beim "Neues Familienblatt einfügen" (siehe Code oben) soll das neue Blatt ohne dem Button, Modul und Makro "Liste leeren" eingefügt werden.

Und mein letzter Wunsch wäre, daß auf der Startseite alle Familienpaarungs-Blätter von Zelle B9 an runterwärts aufgelistet und auf das dementsprechende Blatt verlinkt und sortiert sind. Ausgenommen Startseite und Vorlage.

Sind diese Wünsche möglich? Ich hoffe auf Eure Hilfe, da das Makroschreiben bei mir nur auf das Makro-Aufnehmen beschränkt ist.

Damit Ihr Euch mein Konstrukt vorstellen könnt habe ich es hier hochgeladen.

Internette Grüsse
Mick

Answer 1

Hi, warum der Aufwand. Sowas gibt es schon fertig:
http://wiki-de.genealogy.net/Vorlagen_zur_Erfassung_genealogischer_Daten
Musst nur suchen.

Answer 2

Guten Morgen Como!

Diese Seite kenne ich schon. Es geht mir nicht darum die Blätter mit der Hand auszufüllen, sondernd die Daten in einer Datei abzuspeichern.
Das abspeichern einzelner Blätter soll dazu dienen, den lebenden Familienmitgliedern ihr persönliches Blatt zu schicken.

Internette Grüsse
Mick

Answer 3

Hallo Mick,
habe deine .Datei nach deinen Wünschen angepasst
Speicherort überprüfen: M:\BackUp_Eigene Dateien\Ahnenforschung

Gruß
fedjo

Answer 4

Hallo fedjo!

Vielen, vielen Dank erstmal für Deine Mühe!

Darf ich noch einen Wunsch äußern? Auf der Startseite mit der eingebauten Sortierfunktion "Enthaltene Blätter", wäre es hier möglich die Tabellenblätter "Startseite" und "Vorlage" beim sortieren auszuschließen damit sie auf der Startseite nicht erscheinen?

Mit dem Speicherbutton auf den Familienblättern erhalte ich den Hinweis
"Laufzeitfehler '1004':

Der programmatische Zugriff auf das Visual Basic-Projekt ist nicht sicher"

Könnte ich hier mit der Speicherfunktion, direkt in einen bestimmten Ordner speichern?

Internette Grüsse
Mick

Answer 5

Huch ganz vergessen... zum Wunsch Speichern. Direkt in einen bestimmten Ordner mit dem Tabellenblattnamen.

Internette Grüsse
Mick

Answer 6

Answer 7

Hallo Mick,

quote][Tabellenblatt unter den Namen die in Zelle C1 und E1 stehen, unter M:\BackUp_Eigene Dateien\Ahnenforschung als Einzeldatei abspeichert. Bsp.: Speicherort\GeburtsnameA - GeburtsnameB

.[/quote]

Den Pfad zum speichern muß natürlich von dir angepasst werden.
("M:\BackUp_Eigene Dateien\Ahnenforschung \" & strDateiname)

Der Ordner Ahnenforschung muß auch vorhanden sein, sonst entsteht ein Laufzeitfehler.
Das Tabellenblatt wird mit dem Namen aus C1 und E1 gespeichert.
Startseite" und "Vorlage" werden nach dem sortieren nicht mehr angezeigt.




Familienblatt_Test_001

Gruß
fedjo

Answer 8

Hallo fedjo!

Ich glaube so langsam nerv ich?

Irgend etwas mache ich wohl falsch!
Über den Button "Neues Familienblatt" rufe ich die Meldung "Familiennamen eingeben" auf.
Trage die Familie "FamiliennameA_FamiliennameB" ein.
Fülle das Familienblatt aus.
Gehe auf Speichern und bekomme den Laufzeitfehler angezeigt. Der Ordner "Ahnenforschung" besteht aber.
Gehe weiter auf Debuggen und dieser Text ist gelb unterlegt

For Each Ding In ActiveWorkbook.VBProject.vbcomponents

Hier der ganze Code

Sub VBA_Code_entfernen()
Dim Ding As Object
Dim Zeile As Long
Dim Antwort As Integer


For Each Ding In ActiveWorkbook.VBProject.vbcomponents

'Type 100 = DieseArbeitsmappe und alle Tabellen
If Ding.Type = 100 Then

With ActiveWorkbook.VBProject.vbcomponents(Ding.Name).CodeModule
For Zeile = 1 To .CountOfLines
.DeleteLines 1
Next Zeile
End With

'Type 1 = Modul, Type 2 = Klassenmodul, Type 3 = UserForm
Else
ActiveWorkbook.VBProject.vbcomponents.Remove Ding
End If

Next

End Sub

Internette Grüsse
Mick

Answer 9

Hallo Mick,
habe den Code unter meinem Pfad getestet, wird kein Fehler angezeigt. Der Code "VBA_Code_entfernen" wird automatisch mit dem Code zum "Abspeichern" ausgeführt.

Gruß
fedjo

Option Explicit
Sub Abspeichern()
Dim Name As String
Application.ScreenUpdating = False 'Tabellenwechsel unterbinden
Application.DisplayAlerts = False 'Fehlermeldungen werden unterdrückt
ActiveWindow.SelectedSheets.Copy 'Neue Arbeitsmappe wird erstellt
Dim strDateiname As String
strDateiname = Range("C1").Value & " " & Range("E1").Value & ".xls" 'Arbeitsmappe Name = Zelle C1& E1 + xls
ActiveSheet.Shapes("CommandButton1").Cut 'Button werden gelöscht
ActiveSheet.Shapes("CommandButton2").Cut 'Button werden gelöscht
ActiveSheet.Shapes("CommandButton3").Cut 'Button werden gelöscht
Call VBA_Code_entfernen 'Hier wird der Code Ausgeführt
ActiveWorkbook.SaveAs ("C:\Dokumente und Einstellungen\Admin\Desktop\Muster\" & strDateiname) 'Pfad zum Speichern
ActiveWindow.Close 'Arteitsmappe wird geschlossen
ActiveWindow.SelectedSheets.Delete 'Arbeitsblatt wird gelöscht
Application.DisplayAlerts = True 'Fehlermeldungen werden wieder aktiviert
End Sub

Sub VBA_Code_entfernen()
Dim Ding As Object
Dim Zeile As Long
Dim Antwort As Integer
For Each Ding In ActiveWorkbook.VBProject.vbcomponents
'Type 100 = DieseArbeitsmappe und alle Tabellen
If Ding.Type = 100 Then
With ActiveWorkbook.VBProject.vbcomponents(Ding.Name).CodeModule
For Zeile = 1 To .CountOfLines
.DeleteLines 1
Next Zeile
End With
'Type 1 = Modul, Type 2 = Klassenmodul, Type 3 = UserForm
Else
ActiveWorkbook.VBProject.vbcomponents.Remove Ding
End If
Next
End Sub

Answer 10

Hallo fedjo!

Vielen Dank für Deine Mühen, aber wahrscheinlich bin ich zu doof dafür.
Ist es vielleicht Versions abhängig? Arbeite mit Excel 2002.

Alles andere funktioniert aber tadellos. Werde dann die ganze Mappe speichern und alle Blätter die nicht benötigt werden per Hand löschen incl. Module.

Internette Grüsse
Mick