5 thoughts on “Convert VBA Editor to Dark Theme”

1. Option Explicit
   Dim pApplication As IApplication
   Dim pMxDocument As IMxDocument
   Dim pMap As IMap
   Dim pEditor As IEditor2
   Dim pID As New UID
   Dim pFclass As IFeatureClass
   Dim pFlayer As IFeatureLayer
   Dim pEnumFeat As IEnumFeature
   Dim pFeat As IFeature
   Dim pFeatureLayer As IFeatureLayer2
   Dim WithEvents myMap As Map
   Dim incDecValue As Integer
   Dim planNoValue As Integer
   Dim sum As Integer
   Dim result As String
   Private Sub CommandButton1_Click()
   If ComboBox1.Text = “” Then
   MsgBox “you must select increment or decrement value”
   Exit Sub
   End If
   If TextBox1.Text = “” Then
   MsgBox “you must enter Parcel_no value”
   Exit Sub
   End If
   incDecValue = CInt(ComboBox1.Text)
   planNoValue = CInt(TextBox1.Text)
   sum = (incDecValue + planNoValue)
   result = CStr(sum)
   End Sub
   Private Sub CommandButton2_Click()
   Unload Me
   End Sub
   Private Sub myMap_SelectionChanged()
   On Error GoTo lbl
   Dim strLayerName As String
   If pMap.SelectionCount 1 Then
   MsgBox “No features selected or more than one feature selected”
   Exit Sub
   Else
   Set pEnumFeat = pMap.FeatureSelection
   If pEnumFeat Is Nothing Then Exit Sub
   ‘select 1st selected feature
   Set pFeat = pEnumFeat.Next
   If pFeat Is Nothing Then Exit Sub
   ‘check for multi selectable layers
   If pFeat.Class.AliasName lblTableName.Caption Then
   While pFeat.Class.AliasName lblTableName.Caption
   Set pFeat = pEnumFeat.Next
   If pFeat Is Nothing Then Exit Sub
   Wend
   End If
   End If
   If pEditor.EditState = esriStateNotEditing Then
   ‘MsgBox “start editing”
   Call startEditing(pFeat.Class.AliasName)
   End If
   ‘——————————————————————————————
   ‘befor the user will enter new value we will check the new value of the parcel no has reserved from other parcel no or no if reserved we will select this parcel and zoom to it else the user will continue in editing process .
   ‘———————————————————————–
   ‘ we will do this in other tool called check tool for all check process
   ‘———————————————————————–
   ‘Dim flagval As Boolean
   ‘flagval = checkfoundation(result)
   ‘——————————————————————————————
   ‘Save values to selected feature;
   pFeat.Value(pFeat.Fields.FindField(“ParcelNO”)) = result
   result = result + incDecValue
   pFeat.Store
   pMxDocument.ActiveView.Refresh
   Exit Sub
   lbl:
   MsgBox Err.Description, , “Auto Edit Tool”
   End Sub
   Private Sub UserForm_Initialize()
   On Error GoTo lblErr
   Set pMxDocument = ThisDocument
   Set pMap = pMxDocument.FocusMap
   Set myMap = pMap
   Set pFlayer = pMxDocument.SelectedLayer
   If pFlayer Is Nothing Then
   MsgBox “please select your layer “, vbOKOnly, “Auto Edit Tool”
   Exit Sub
   End If
   Set pFclass = pFlayer.FeatureClass
   Dim strTableName As String
   strTableName = pFclass.AliasName
   lblTableName.Caption = strTableName ‘Make sense for table to be affected
   ComboBox1.AddItem “-2”, 0
   ComboBox1.AddItem “-1”, 1
   ComboBox1.AddItem “1”, 2
   ComboBox1.AddItem “2”, 3
   ComboBox1.AddItem “3”, 4
   ComboBox1.Text = “-2”
   startEditing strTableName
   ‘Getting all dataset info from selected layer
   Exit Sub
   lblErr:
   MsgBox Err.Description, vbOKOnly, “Auto Edit Tool”
   End Sub
   Public Sub startEditing(ByVal strLayerName As String)
   pID = “esriEditor.Editor”
   Set pEditor = Application.FindExtensionByCLSID(pID)
   If pEditor.EditState = esriStateNotEditing Then
   Dim pDataset As IDataset
   Dim intCount As Integer
   For intCount = 0 To pMap.LayerCount – 1
   If pMap.Layer(intCount).Name = strLayerName Then
   Set pFeatureLayer = pMap.Layer(intCount)
   Set pDataset = pFeatureLayer.FeatureClass
   pEditor.startEditing pDataset.Workspace
   pEditor.StartOperation
   Exit For
   End If
   Next intCount
   Else
   Exit Sub
   End If
   End Sub
   Public Function checkfoundation(ResultVal As String) As Boolean
   Dim pfcursour As IFeatureCursor
   Dim i As Integer
   Dim pfeature As IFeature
   Dim pqfilter As IQueryFilter
   Dim flag As Boolean
   Dim pfLSelection As IFeatureSelection
   flag = True
   Set pMxDocument = ThisDocument
   Set pMap = pMxDocument.FocusMap
   Set pFlayer = pMxDocument.SelectedLayer
   Set pFclass = pFlayer.FeatureClass
   Set pfLSelection = pFlayer
   Set pqfilter = New QueryFilter
   pqfilter.WhereClause = “ParcelNO =” & “‘” & ResultVal & “‘”
   Set pfcursour = pFclass.Search(pqfilter, False)
   Set pfeature = pfcursour.NextFeature
   Do Until pfeature Is Nothing
   flag = False
   Debug.Print pfeature.OID
   pfLSelection.SelectFeatures Nothing, esriSelectionResultNew, True
   Set pfeature = pfcursour.NextFeature
   Loop
   checkfoundation = flag
   End Function

   Reply
2. Pingback: VBA Dark Theme - Pascal ter Heege

3. Thank you so much!
   This post help me a lot.

   Reply

   1. I am so glad. 😀

      Reply

4. Very helpful. Thank you!!!

   Reply