Hallo zusammen.
Habe folgendes Problem wenn shapes grupiert sind werden sie bei mir nicht exportiert bzw. manche nicht als shape erkannt was in VBA zu folgendem Fehler führt:
TYpen Unverträglich kann man dies irgendwie programmiertechnisch umgehen?
fkt die ein Shape objekt bekommt und in DB einträgt
Public Sub insertIntoDb(shp As Visio.Shape, z_pos As Integer)
On Error GoTo error_handler
oCM.ActiveConnection = oCn
'Insert String**********************************************************************************************
oCM.CommandText = "INSERT INTO DocShps (RES_18, shpName, PinX, PinY, PinZ, Angle) VALUES (" & shp.ID & ",'" & _
shp.Master.Name & "','" & _
shp.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU & "','" & _
shp.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU & "','" & z_pos & "','" & _
shp.CellsSRC(visSectionObject, visRowXFormOut, visXFormAngle).FormulaU & "')"
'************************************************************************************************************
oCM.Execute
Exit Sub
error_handler:
Exit Sub
'close conection
CloseDB_Connection
'for develop
Debug.Assert False
End Sub
Funktion die die shapes ausliesst
Public Sub LayCon()
Dim PagObjs As Visio.Pages
Dim z As Integer
Dim PagObj As Visio.Page
Dim cntPages
Dim layersObj As Visio.Layers, layerObj As Visio.Layer
Dim shpsObj As Visio.Shapes
Dim shpObj As Visio.Shape
Dim cntshp As Integer
cntshp = 0
z = 0
'open Database
OpenDB_Connection
'alle Sheets einlesen
For Each PagObj In ActiveDocument.Pages
Set layersObj = PagObj.Layers
With PagObj
For Each shpObj In .Shapes
Debug.Assert shpObj.Name
cntshp = cntshp + 1
'ActiveWindow.DeselectAll
'insert shape attributes into Database
insertIntoDb shpObj, z
Next 'next shpsObj
End With
z = z + 1
Next
'close Database
CloseDB_Connection
If cntshp = 0 Then
MsgBox "keine Shapes Vorhanden!"
End If
End Sub
DANKE fürr jede möglichen hilfsansatzt oder lösungsvorschlag
|