'tohle je v This Document
Private Sub UIButtonControl1_Click()
    Load UserForm1
    UserForm1.Caption = "Vyber parcely"
    UserForm1.Show vbModeless
End Sub



'tohle je v kodu k user form

Private Sub CommandButton1_Click()
    VyberKraj (ComboBox1.Text)
End Sub
Private Sub UserForm_Initialize()
    Dim i As Integer
    Dim nazev As String
    Dim pLayer As IFeatureLayer
    Dim pFC As IFeatureClass
    
    Set pLayer = getLayer("kraje")
    Set pFC = pLayer.FeatureClass
    
    Dim pFCursor As IFeatureCursor
    Set pFCursor = pFC.Search(Nothing, False)
    
    Dim pFeature As IFeature
    For i = 1 To pFC.FeatureCount(Nothing)
        Set pFeature = pFCursor.NextFeature
        nazev = pFeature.Value(4)
        ComboBox1.AddItem (nazev)
    Next i
    
End Sub

Private Function VyberKraj(jmeno As String)
    Dim pLayer As IFeatureLayer
    Dim pFC As IFeatureClass
    
    Set pLayer = getLayer("kraje")
    Set pFC = pLayer.FeatureClass
    
    Dim pFCursor As IFeatureCursor
    Set pFCursor = pFC.Search(Nothing, False)
    
    
    Dim pFeature As IFeature
    Dim krajFeature As IFeature
    For i = 1 To pFC.FeatureCount(Nothing)
        Set pFeature = pFCursor.NextFeature
        If pFeature.Value(4) = jmeno Then
            Set krajFeature = pFeature
        End If
    Next i
    
    If krajFeature Is Nothing Then
        MsgBox "kraj neexistuje"
        Exit Function
    End If
    
    Dim shape As IGeometry
    Set shape = krajFeature.ShapeCopy
    Dim ctyruhelnik As IEnvelope
    Set ctyruhelnik = shape.Envelope
    
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
       
    Dim pFilter As IQueryFilter
    Set pFilter = New QueryFilter
    pFilter.WhereClause = "NAZEV = '" & jmeno & "'"
    
    Dim pFSel As IFeatureSelection
    Set pFSel = pLayer
    pFSel.SelectFeatures pFilter, esriSelectionResultNew, True
    
    ctyruhelnik.Expand 20000, 20000, False
    pMxDoc.ActiveView.Extent = ctyruhelnik
    pMxDoc.ActiveView.Refresh
End Function
Private Function getLayer(name As String) As IFeatureLayer
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    
    Set pMxDoc = Application.Document
    Set pMap = pMxDoc.FocusMap
    
    Dim pLayers As IEnumLayer
    Dim pLayer As IFeatureLayer
    
    Set pLayers = pMap.Layers
    Set pLayer = pLayers.Next
    
    While Not pLayer Is Nothing
        If pLayer.name = name Then
            Set getLayer = pLayer
            Exit Function
        End If
        Set pLayer = pLayers.Next
    Wend
    If pLayer Is Nothing Then
        MsgBox "vrstva nebyla v mape nalezena"
        Set getLayer = Nothing
    End If
    Exit Function
End Function