Алфавитный контроль над словом userform - PullRequest
Новая
       35

Алфавитный контроль над словом userform

0 голосов
/ 25 сентября 2019

Я опубликовал это ранее.Однако с тех пор я смог выяснить алфавитную коллекцию.Я удалил пост, так как это был беспорядок.

Я хочу расположить элементы управления по форме в алфавитном порядке по мере их размещения на форме.У меня есть коллекция в алфавитном порядке, однако я борюсь за порядок кода.То, как это сейчас, добавляется только первая строка.

Вот как это должно выглядеть:

enter image description here

Private Sub UserForm_Initialize()

On Error GoTo Err_UserForm_Initialize

Set objNode = ActiveDocument.CustomXMLParts.SelectByNamespace("http://schemas.rlicorp.net/ContentManagement.Claims").Item(1).DocumentElement

If objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]") Is Nothing Then
    Exit Sub
End If

Dim ctlTo As Control
Dim ctlCc As Control
Dim ctlName As Control
Dim ctlTempName As Control
Dim ctlAddress1 As Control
Dim ctlAddress2 As Control
Dim ctlCity As Control
Dim ctlState As Control
Dim ctlZIP As Control
Dim ctlRole As Control
Dim cName As Variant
Dim tempname As String
Dim coll As Collection
Dim i As Long
Dim nAddresses As Integer

Set objNode = ActiveDocument.CustomXMLParts.SelectByNamespace("http://schemas.rlicorp.net/ContentManagement.Claims").Item(1).DocumentElement

nAddresses = 0

Set coll = nameCollection

For i = 1 To Int(objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes.Count)
    Set objNode1 = objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes(i)

    If (Not (objNode1.SelectSingleNode("ns0:Address1[1]") Is Nothing)) Or _
    (Not (objNode1.SelectSingleNode("ns0:Name[1]") Is Nothing)) Then
        nAddresses = nAddresses + 1

        For Each cName In nameCollection

            If Not (objNode1.SelectSingleNode("ns0:Name[1]") Is Nothing) Then
                tempname = objNode1.SelectSingleNode("ns0:Name[1]").Text
            End If

            If cName <> tempname Then Exit For
            Debug.Print cName

            Set ctlTo = fraSelectContact.Controls.Add("Forms.Checkbox.1", "chkTo" & nAddresses)
            ctlTo.Left = lblTo.Left
            ctlTo.Top = lblTo.Top + 20 + (nAddresses - 1) * 30

            Set ctlCc = fraSelectContact.Controls.Add("Forms.Checkbox.1", "chkCc" & nAddresses)
            ctlCc.Left = lblCc.Left
            ctlCc.Top = lblCc.Top + 20 + (nAddresses - 1) * 30

            Set ctlName = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtName" & nAddresses)
            ctlName.Left = lblName.Left
            ctlName.Top = lblName.Top + 20 + (nAddresses - 1) * 30
            ctlName.Width = 130
            ctlName.Text = cName

            Set ctlAddress1 = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtAddress1_" & nAddresses)
            ctlAddress1.Left = lblAddress1.Left
            ctlAddress1.Top = lblAddress1.Top + 20 + (nAddresses - 1) * 30
            ctlAddress1.Width = 170
            If Not (objNode1.SelectSingleNode("ns0:Employer[1]") Is Nothing) Then
                ctlAddress1.Text = objNode1.SelectSingleNode("ns0:Employer[1]").Text & ";"
            End If
            If Not (objNode1.SelectSingleNode("ns0:Address1[1]") Is Nothing) Then
                ctlAddress1.Text = ctlAddress1.Text & objNode1.SelectSingleNode("ns0:Address1[1]").Text
            End If

            Set ctlAddress2 = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtAddress2_" & nAddresses)
            ctlAddress2.Left = lblAddress2.Left
            ctlAddress2.Top = lblAddress2.Top + 20 + (nAddresses - 1) * 30
            ctlAddress2.Width = 160
            If Not (objNode1.SelectSingleNode("ns0:Address2[1]") Is Nothing) Then
                ctlAddress2.Text = objNode1.SelectSingleNode("ns0:Address2[1]").Text
            End If

            Set ctlCity = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtCity" & nAddresses)
            ctlCity.Left = lblCity.Left
            ctlCity.Top = lblCity.Top + 20 + (nAddresses - 1) * 30
            ctlCity.Width = 60
            If Not (objNode1.SelectSingleNode("ns0:City[1]") Is Nothing) Then
                ctlCity.Text = objNode1.SelectSingleNode("ns0:City[1]").Text
            End If

            Set ctlState = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtState" & nAddresses)
            ctlState.Left = lblState.Left
            ctlState.Top = lblState.Top + 20 + (nAddresses - 1) * 30
            ctlState.Width = 30
            If Not (objNode1.SelectSingleNode("ns0:State[1]") Is Nothing) Then
                ctlState.Text = objNode1.SelectSingleNode("ns0:State[1]").Text
            End If

            Set ctlZIP = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtZIP" & nAddresses)
            ctlZIP.Left = lblZIP.Left
            ctlZIP.Top = lblZIP.Top + 20 + (nAddresses - 1) * 30
            ctlZIP.Width = 50
            If Not (objNode1.SelectSingleNode("ns0:Zip[1]") Is Nothing) Then
                ctlZIP.Text = objNode1.SelectSingleNode("ns0:Zip[1]").Text
            End If

        Next cName
    End If
Next i

Exit_UserForm_Initialize:
Exit Sub

Err_UserForm_Initialize:
MsgBox Err.Number & " _ " & Err.Description & vbCrLf & "Contact claimcenterhelp@rlicorp.com"
Resume Exit_UserForm_Initialize

End Sub

unction nameCollection() As Collection

Dim coll As Collection
Set coll = New Collection

Set objNode = ActiveDocument.CustomXMLParts.SelectByNamespace("http://schemas.rlicorp.net/ContentManagement.Claims").Item(1).DocumentElement

For i = 1 To Int(objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes.Count)
    Set objNode1 = objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes(i)

    If Not (objNode1.SelectSingleNode("ns0:Name[1]") Is Nothing) Then
        coll.Add Item:=objNode1.SelectSingleNode("ns0:Name[1]").Text
    End If

Next i

QuickSort coll, 1, coll.Count

Set nameCollection = coll

End Function
Sub QuickSort(coll As Collection, first As Long, last As Long)

Dim vCentreVal As Variant, vTemp As Variant
Dim lTempLow As Long
Dim lTempHi As Long

lTempLow = first
lTempHi = last

vCentreVal = coll((first + last) \ 2)

Do While lTempLow <= lTempHi

Do While coll(lTempLow) < vCentreVal And lTempLow < last
    lTempLow = lTempLow + 1
Loop

Do While vCentreVal < coll(lTempHi) And lTempHi > first
    lTempHi = lTempHi - 1
Loop

If lTempLow <= lTempHi Then
    vTemp = coll(lTempLow)

    coll.Add coll(lTempHi), After:=lTempLow
    coll.Remove lTempLow

    coll.Add vTemp, Before:=lTempHi
    coll.Remove lTempHi + 1

    lTempLow = lTempLow + 1
    lTempHi = lTempHi - 1

End If

Loop

If first < lTempHi Then QuickSort coll, first, lTempHi
If lTempLow < last Then QuickSort coll, lTempLow, last

End Sub

Я не получаю никаких ошибок при запуске этого, но это то, что форма выглядит так:

enter image description here

Это сокращенныйверсия XML 

<?xml version="1.0" encoding="utf-8" ?> 
- <Claim xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
  <ID>00989876</ID> 
  <Description>General Liability</Description> 
  <ContractID>A78656789</ContractID> 
+ <Contract>
- <Contacts>
- <ClaimContact>
  <Name>John Doe</Name> 
  <Address1>PO Box 712</Address1> 
  <City>Jacksonville</City> 
  <State>FL</State> 
  <Zip>98631</Zip> 
  </ClaimContact>
- <ClaimContact>
  <Name>Alton Carpeting</Name> 
  <Address1>4567 Watchworks Ave</Address1> 
 <City>Detroit</City> 
  <State>MI</State> 
  <Zip>98631</Zip> 
  </ClaimContact>
+ <ClaimContact>
+ <ClaimContact>
  </Contacts>
  <ClaimUser /> 
  </Claim>

1 Ответ

0 голосов
/ 26 сентября 2019

Наконец-то разобрался.Просто нужно было выложить высказывания в правильном порядке.Спасибо Майк и Синди за вашу помощь. 

Private Sub UserForm_Initialize()

On Error GoTo Err_UserForm_Initialize

Set objNode = ActiveDocument.CustomXMLParts.SelectByNamespace("http://schemas.rlicorp.net/ContentManagement.Claims").Item(1).DocumentElement

If objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]") Is Nothing Then
    Exit Sub
End If

Dim ctlTo As Control
Dim ctlCc As Control
Dim ctlName As Control
Dim ctlAddress1 As Control
Dim ctlAddress2 As Control
Dim ctlCity As Control
Dim ctlState As Control
Dim ctlZIP As Control
Dim ctlRole As Control
Dim cName As Variant
Dim tempname As String
Dim coll As Collection

Set objNode = ActiveDocument.CustomXMLParts.SelectByNamespace("http://schemas.rlicorp.net/ContentManagement.Claims").Item(1).DocumentElement
nAddresses = 0

Set coll = nameCollection

For Each cName In coll


For i = 1 To Int(objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes.Count)
    Set objNode1 = objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes(i)


                If Not (objNode1.SelectSingleNode("ns0:Name[1]") Is Nothing) Then
                tempname = objNode1.SelectSingleNode("ns0:Name[1]").Text
                End If

                If cName = tempname Then
                Debug.Print cName

        If (Not (objNode1.SelectSingleNode("ns0:Address1[1]") Is Nothing)) Or _
    (Not (objNode1.SelectSingleNode("ns0:Name[1]") Is Nothing)) Then
    nAddresses = nAddresses + 1

                Set ctlTo = fraSelectContact.Controls.Add("Forms.Checkbox.1", "chkTo" & nAddresses)
                ctlTo.Left = lblTo.Left
                ctlTo.Top = lblTo.Top + 20 + (nAddresses - 1) * 30

                Set ctlCc = fraSelectContact.Controls.Add("Forms.Checkbox.1", "chkCc" & nAddresses)
                ctlCc.Left = lblCc.Left
                ctlCc.Top = lblCc.Top + 20 + (nAddresses - 1) * 30

                Set ctlName = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtName" & nAddresses)
                ctlName.Left = lblName.Left
                ctlName.Top = lblName.Top + 20 + (nAddresses - 1) * 30
                ctlName.Width = 130

                ctlName.Text = cName

                Set ctlAddress1 = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtAddress1_" & nAddresses)
                ctlAddress1.Left = lblAddress1.Left
                ctlAddress1.Top = lblAddress1.Top + 20 + (nAddresses - 1) * 30
                Debug.Print ctlAddress1.Top
                ctlAddress1.Width = 170
                If Not (objNode1.SelectSingleNode("ns0:Employer[1]") Is Nothing) Then
                    ctlAddress1.Text = objNode1.SelectSingleNode("ns0:Employer[1]").Text & ";"
                End If
                If Not (objNode1.SelectSingleNode("ns0:Address1[1]") Is Nothing) Then
                    ctlAddress1.Text = ctlAddress1.Text & objNode1.SelectSingleNode("ns0:Address1[1]").Text
                End If

                Set ctlAddress2 = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtAddress2_" & nAddresses)
                ctlAddress2.Left = lblAddress2.Left
                ctlAddress2.Top = lblAddress2.Top + 20 + (nAddresses - 1) * 30
                ctlAddress2.Width = 160
                If Not (objNode1.SelectSingleNode("ns0:Address2[1]") Is Nothing) Then
                    ctlAddress2.Text = objNode1.SelectSingleNode("ns0:Address2[1]").Text
                End If

                Set ctlCity = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtCity" & nAddresses)
                ctlCity.Left = lblCity.Left
                ctlCity.Top = lblCity.Top + 20 + (nAddresses - 1) * 30
                ctlCity.Width = 60
                If Not (objNode1.SelectSingleNode("ns0:City[1]") Is Nothing) Then
                    ctlCity.Text = objNode1.SelectSingleNode("ns0:City[1]").Text
                End If

                Set ctlState = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtState" & nAddresses)
                ctlState.Left = lblState.Left
                ctlState.Top = lblState.Top + 20 + (nAddresses - 1) * 30
                ctlState.Width = 30
                If Not (objNode1.SelectSingleNode("ns0:State[1]") Is Nothing) Then
                    ctlState.Text = objNode1.SelectSingleNode("ns0:State[1]").Text
                End If

                Set ctlZIP = fraSelectContact.Controls.Add("Forms.TextBox.1", "txtZIP" & nAddresses)
                ctlZIP.Left = lblZIP.Left
                ctlZIP.Top = lblZIP.Top + 20 + (nAddresses - 1) * 30
                ctlZIP.Width = 50
                If Not (objNode1.SelectSingleNode("ns0:Zip[1]") Is Nothing) Then
                    ctlZIP.Text = objNode1.SelectSingleNode("ns0:Zip[1]").Text
                End If

            End If
            End If
            Next i
    Next cName

Exit_UserForm_Initialize:
Exit Sub

Err_UserForm_Initialize:
MsgBox Err.Number & " _ " & Err.Description & vbCrLf & "Contact claimcenterhelp@rlicorp.com"
Resume Exit_UserForm_Initialize

End Sub

Function nameCollection() As Collection

Dim coll As Collection
Set coll = New Collection

Set objNode = ActiveDocument.CustomXMLParts.SelectByNamespace("http://schemas.rlicorp.net/ContentManagement.Claims").Item(1).DocumentElement

For i = 1 To Int(objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes.Count)
    Set objNode1 = objNode.SelectSingleNode("/ns0:Claim[1]/ns0:Contacts[1]").ChildNodes(i)

    If Not (objNode1.SelectSingleNode("ns0:Name[1]") Is Nothing) Then
        coll.Add Item:=objNode1.SelectSingleNode("ns0:Name[1]").Text
    End If

Next i

'For x = 1 To coll.Count
'Debug.Print coll(x)
'Next x

QuickSort coll, 1, coll.Count

Set nameCollection = coll

End Function

Sub QuickSort(coll As Collection, first As Long, last As Long)

  Dim vCentreVal As Variant, vTemp As Variant

  Dim lTempLow As Long
  Dim lTempHi As Long
  lTempLow = first
  lTempHi = last

  vCentreVal = coll((first + last) \ 2)
  Do While lTempLow <= lTempHi

    Do While coll(lTempLow) < vCentreVal And lTempLow < last
      lTempLow = lTempLow + 1
    Loop

    Do While vCentreVal < coll(lTempHi) And lTempHi > first
      lTempHi = lTempHi - 1
    Loop

    If lTempLow <= lTempHi Then

      ' Swap values
      vTemp = coll(lTempLow)

      coll.Add coll(lTempHi), After:=lTempLow
      coll.Remove lTempLow

      coll.Add vTemp, Before:=lTempHi
      coll.Remove lTempHi + 1

      ' Move to next positions
      lTempLow = lTempLow + 1
      lTempHi = lTempHi - 1

    End If

  Loop

  If first < lTempHi Then QuickSort coll, first, lTempHi
  If lTempLow < last Then QuickSort coll, lTempLow, last

End Sub
...