Office: Visio 2003 und Acces 2003

Hallo ihr alle!!

Ich habe vollgendes Problem!

Ich will ein Orgigramm erstellen und bekomme es nicht wirklich hin die Daten aus der Acces Dateenbank in die Visio Shapes einzuspeisen.

Wie kann ich das machen und wie kann ich Das z.B. über Makros so Programmieren, dass Visio beim Start automatisch Shapes für neue Mitarbeiter erstellt aber auch leere shapes löscht? Dazu muss ich noch wissen wie ich den Shapes eine gewisse reihenfolge geben kann. Ich meine damit, das ich die Shapes in Abteilungen abtrenne. z.B.: Mitarbeite XY sitz in der Abteilung Z und ist abteilungsleiter. Unter ihm steht Der Mitarbeiter Peter ist dann somit Z1. Wie bekomme ich das Automatisch unter einander.

Ich hoffe mir kann da einer behilflich sein.

Danke schon mal im Vorraus

Lieben Gruß

Jan Schumacher

 

Sub main()
Dim datei, datenzeichen As String
Dim rechteck As Visio.Shape
Dim umr As Double

umr = 0.039370079 'Umrechnung von Zoll in mm

Set rechteck = ActivePage.DrawRectangle((5 * umr), (290 * umr), (30 * umr), (265 * umr))

' den ganzen Dateninhalt in einer Variablen speichern
Close #1
Open "C:\Dokumente und Einstellungen\Sevay\Eigene Dateien\test.txt" For Input As #1
Line Input #1, datenzeichen
' hier kein close#1!


Do While datei <> "ENDE"
Line Input #1, datenzeichen ' Datenzeile lesen.
datei = Input(4, #1) 'Zeichen einlesen
rechteck.Text = rechteck.Text & "Zeile " & ": " & datenzeichen & Chr(10) ' Zeileninhalt schreiben

Loop

Close #1
End Sub

hiermit kann ich ja aus einer Text datei Daten ins Visio.Shape automatisch schreiben aber wie geht das jetzt mit einer Acces Datenbank?

Das er mir das so anzeigt

Z1
Abteilungsleiter
Dr. Peter Maffei
Tel: 1256(4589)
Fax: 3569

kann mir das einer erklären???

Ich habe es auch schon hinbekommen auf die Datenbank zu zugreifen. Mit diesem Code.

Dim db As Database
'Dim rs1 As RecordSet
Dim rechteck As Visio.Shape

Sub asdjasd()

umr = 0.039370079 'Umrechnung von Zoll in mm

Set db = DBEngine(0).OpenDatabase("C:\OE Bundesministerium.mdb")
Set rs1 = db.OpenRecordset("Header_Bedienstete", dbOpenTable)
Set rechteck = ActivePage.DrawRectangle((5 * umr), (290 * umr), (30 * umr), (265 * umr))

rs1.MoveFirst
Do While (Not rs1.EOF)
'MsgBox (rs1.Fields("Amt").Value)
rs1.MoveNext
Loop

End Sub

Vielleicht hilft das ja weiter