Hallo liebe Gis-Gemeinde,
ich quäle mich seit Tagen mit einem Problem in VBA, ohne es auch nach vielem Studieren und Probieren in den Griff zu bekommen.
Es ist für mich nur ein Test-Tool, um VBA zu lernen - das als kleine Anmerkung vorweg:
Also, das Tool fügt eine definierte Spalte in der Attributtabelle eines selektierten Layers hinzu; hierzu wird anfangs über eine InputBox eine Name für die gewünschte Spalte abgefragt und dann über ein Formular der entsprechende Datentyp bestimmt.
Mein Problem in diesem bestimmten Fall betrifft das ErrorHandling innerhalb der UserForm. Ich möchte alle evtl. auftretenden UserFehler abfangen und scheitere daran, dass ich nicht weiß wie ich das X (Schließen des Formular-Fensters) abfangen kann.
Also schließt der User die Form über das "X" soll ein Exit Sub stattfinden und tut er das nicht, soll der Code weiter abgearbeitet werden, aber ich bekomme es einfach nicht hin, weil ich nicht weiß wie ich dieses ver....X ansprechen muss - das kann doch nicht so schwer sein, oder?
Ich poste mal meinen Code:
Option Explicit
Public bytFeldtypAuswahl As Byte
Public Sub AddsimpleField()
On Error GoTo Errorhandler
Dim pMxDoc As IMxDocument
Dim pLayer As ILayer
Dim pFLayer As IFeatureLayer
Dim pFeatClass As IFeatureClass
Dim NewField As IFieldEdit
Dim strFieldName As String
Dim Cancel As Integer
Dim UnloadMode As Integer
Set pMxDoc = ThisDocument
Set pLayer = pMxDoc.SelectedLayer
If pLayer Is Nothing Then
MsgBox "Es ist kein Layer selektiert" & vbCrLf & "Das Tool wird beendet!", _
vbCritical, "Fehler"
Exit Sub
End If
Set pFLayer = pLayer
Set pFeatClass = pFLayer.FeatureClass
strFieldName = InputBox("Bitte geben Sie den Namen des neuen Feldes an!", "Feld hinzufügen")
' Die Funktion StrPtr liefert den Wert des Zeigers (das ist, vereinfacht gesagt,
' die Speicheradresse des Strings) zu einem String. Und bei einem uninitialisierten
' String ist dieser Wert schlicht 0, da ein uninitialisierter String für VB noch
' nicht existiert. Prüfen Sie also mit dieser Funktion den übergebenen optionalen
' String-Parameter.
If StrPtr(strFieldName) = 0 Then
MsgBox "Der Vorgang wird auf Ihren Wunsch abgebrochen!", vbExclamation, "Abbruch"
Exit Sub
ElseIf strFieldName = "" Then
MsgBox "Sie haben keinen Feldnamen vergeben!", vbExclamation, "Fehler"
Exit Sub
ElseIf pFeatClass.FindField(strFieldName) > -1 Then
MsgBox "Ein gleichnamiges Feld ist bereits vorhanden!" & vbCrLf & _
"Bitte wiederholen Sie den Vorgang und geben einen anderen Namen ein!", _
vbExclamation, "Feldname bereits vorhanden"
Exit Sub
Else
MsgBox "Der vergebene Feldname lautet:" & vbCrLf & strFieldName, vbInformation, _
"Bestätigung Feldname"
End If
frmFeldtyp.Show
'Nach meinem Verständnis gehört hierher der Code über eine If...Then-Clause, dass
'abgebrochen wird wenn der User die Form "frmFeldtyp" über das "X" (Fenster schließen)
'schließen möchte
If frmFeldtyp.OptionButton1 = True Then
bytFeldtypAuswahl = 3
ElseIf frmFeldtyp.OptionButton2 = True Then
bytFeldtypAuswahl = 5
Else: bytFeldtypAuswahl = 4
End If
Set NewField = New Field
With NewField
.Type = bytFeldtypAuswahl
.Name = strFieldName
End With
pFeatClass.AddField NewField
Unload frmFeldtyp
Exit Sub
Errorhandler: MsgBox "Es ist ein Fehler aufgetreten!" & vbCrLf & "Das Tool wird beendet!", vbExclamation, "Error"
End Sub
Private Sub AddField_Click()
Call AddsimpleField
End Sub
Private Function AddField_Message() As String
AddField_Message = "By clicking this button you can add a user specified field to a layer!"
End Function
Private Function AddField_ToolTip() As String
AddField_ToolTip = "Add Field"
End Function
Vielen Dank schon mal im Voraus vom "Ups"!
ich quäle mich seit Tagen mit einem Problem in VBA, ohne es auch nach vielem Studieren und Probieren in den Griff zu bekommen.
Es ist für mich nur ein Test-Tool, um VBA zu lernen - das als kleine Anmerkung vorweg:
Also, das Tool fügt eine definierte Spalte in der Attributtabelle eines selektierten Layers hinzu; hierzu wird anfangs über eine InputBox eine Name für die gewünschte Spalte abgefragt und dann über ein Formular der entsprechende Datentyp bestimmt.
Mein Problem in diesem bestimmten Fall betrifft das ErrorHandling innerhalb der UserForm. Ich möchte alle evtl. auftretenden UserFehler abfangen und scheitere daran, dass ich nicht weiß wie ich das X (Schließen des Formular-Fensters) abfangen kann.
Also schließt der User die Form über das "X" soll ein Exit Sub stattfinden und tut er das nicht, soll der Code weiter abgearbeitet werden, aber ich bekomme es einfach nicht hin, weil ich nicht weiß wie ich dieses ver....X ansprechen muss - das kann doch nicht so schwer sein, oder?
Ich poste mal meinen Code:
Option Explicit
Public bytFeldtypAuswahl As Byte
Public Sub AddsimpleField()
On Error GoTo Errorhandler
Dim pMxDoc As IMxDocument
Dim pLayer As ILayer
Dim pFLayer As IFeatureLayer
Dim pFeatClass As IFeatureClass
Dim NewField As IFieldEdit
Dim strFieldName As String
Dim Cancel As Integer
Dim UnloadMode As Integer
Set pMxDoc = ThisDocument
Set pLayer = pMxDoc.SelectedLayer
If pLayer Is Nothing Then
MsgBox "Es ist kein Layer selektiert" & vbCrLf & "Das Tool wird beendet!", _
vbCritical, "Fehler"
Exit Sub
End If
Set pFLayer = pLayer
Set pFeatClass = pFLayer.FeatureClass
strFieldName = InputBox("Bitte geben Sie den Namen des neuen Feldes an!", "Feld hinzufügen")
' Die Funktion StrPtr liefert den Wert des Zeigers (das ist, vereinfacht gesagt,
' die Speicheradresse des Strings) zu einem String. Und bei einem uninitialisierten
' String ist dieser Wert schlicht 0, da ein uninitialisierter String für VB noch
' nicht existiert. Prüfen Sie also mit dieser Funktion den übergebenen optionalen
' String-Parameter.
If StrPtr(strFieldName) = 0 Then
MsgBox "Der Vorgang wird auf Ihren Wunsch abgebrochen!", vbExclamation, "Abbruch"
Exit Sub
ElseIf strFieldName = "" Then
MsgBox "Sie haben keinen Feldnamen vergeben!", vbExclamation, "Fehler"
Exit Sub
ElseIf pFeatClass.FindField(strFieldName) > -1 Then
MsgBox "Ein gleichnamiges Feld ist bereits vorhanden!" & vbCrLf & _
"Bitte wiederholen Sie den Vorgang und geben einen anderen Namen ein!", _
vbExclamation, "Feldname bereits vorhanden"
Exit Sub
Else
MsgBox "Der vergebene Feldname lautet:" & vbCrLf & strFieldName, vbInformation, _
"Bestätigung Feldname"
End If
frmFeldtyp.Show
'Nach meinem Verständnis gehört hierher der Code über eine If...Then-Clause, dass
'abgebrochen wird wenn der User die Form "frmFeldtyp" über das "X" (Fenster schließen)
'schließen möchte
If frmFeldtyp.OptionButton1 = True Then
bytFeldtypAuswahl = 3
ElseIf frmFeldtyp.OptionButton2 = True Then
bytFeldtypAuswahl = 5
Else: bytFeldtypAuswahl = 4
End If
Set NewField = New Field
With NewField
.Type = bytFeldtypAuswahl
.Name = strFieldName
End With
pFeatClass.AddField NewField
Unload frmFeldtyp
Exit Sub
Errorhandler: MsgBox "Es ist ein Fehler aufgetreten!" & vbCrLf & "Das Tool wird beendet!", vbExclamation, "Error"
End Sub
Private Sub AddField_Click()
Call AddsimpleField
End Sub
Private Function AddField_Message() As String
AddField_Message = "By clicking this button you can add a user specified field to a layer!"
End Function
Private Function AddField_ToolTip() As String
AddField_ToolTip = "Add Field"
End Function
Vielen Dank schon mal im Voraus vom "Ups"!
- Anmelden oder Registieren, um Kommentare verfassen zu können