Thema Datum  Von Nutzer Rating
Antwort
Rot Fehler meldung
 05.05.2009 13:17:36 guitar
NotSolved

Ansicht des Beitrags:
Von:
guitar		 Datum:
05.05.2009 13:17:36		 Views:
1966		 Rating:
     
Antwort:
  Ja
Thema:
Fehler meldung
hallo zusammen habe folgendes problem ich möchte gerne die eigenschafften der shapes aus visio in eine access DB 2003 schreiben nun hab ich das problem das er mir die DB erstellt die tabelle auch aber sobald ich Insert über eine eigene fkt. mache gibt er mir Laufzeitfehler 91 Objektvariable oder WIthblockvariable nicht festgelegt aus.


Sub CreateDB()
sDBPAth = "D:\VisCad3.mdb"
sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDBPAth & ";"
' Neues adox objekt
Set oDB = New ADOX.Catalog
oDB.Create sConStr
Set oCn = New ADODB.Connection
oCn.ConnectionString = sConStr
oCn.Open
Set oCM = New ADODB.Command
oCM.ActiveConnection = oCn
oCM.CommandText = "Create Table Shapes ( ID INT,shpName TEXT, PinX INT, PinY INT,Angle INT)"
oCM.Execute
If Not oCM Is Nothing Then Set oCM = Nothing
If Not oCn Is Nothing Then Set oCn = Nothing
If Not oDB Is Nothing Then Set oDB = Nothing

Err_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub



Public Sub insertIntoDb(s As Visio.Shape)

oCM.CommandText = "INSERT INTO Shapes(i ,shpName, PinX, PinY , Angle) VALUES(id,s.name,s.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU,s.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU,s.CellsSRC(visSectionObject, visRowXFormOut, visXFormAngle).FormulaU)"
oCM.Execute
If Not oCM Is Nothing Then Set oCM = Nothing
If Not oCn Is Nothing Then Set oCn = Nothing
If Not oDB Is Nothing Then Set oDB = Nothing

Err_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub






Public Sub LayCon()
Dim PagObj As Visio.Page
Dim layersObj As Visio.Layers
Dim layerObj As Visio.Layer
Dim shpsObj As Visio.Shapes, shpObj As Visio.Shape
Dim shptmp As Visio.Shape
i = 0

For Each PagObj In ActiveDocument.Pages
Set layersObj = PagObj.Layers
For Each layerObj In layersObj
Set shpsObj = layerObj.Page.Shapes
For Each shpObj In shpsObj
i = i + 1

insertIntoDb shpObj


Debug.Print "SHAPENAME: "; shpObj.name
Debug.Print " "
Debug.Print "Pin X "; shpObj.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU
Debug.Print "Pin Y "; shpObj.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU
Debug.Print ""
Debug.Print "Ausrichtung in Grad "; shpObj.CellsSRC(visSectionObject, visRowXFormOut, visXFormAngle).FormulaU

Next
Next
Next
End Sub

wäre super nett
dDanke




Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Fehler meldung
 05.05.2009 13:17:36 guitar
NotSolved