Использование таблицы VBA: разделить ячейку, если вставляемая строка имеет знак + - PullRequest
Новая
       60

Использование таблицы VBA: разделить ячейку, если вставляемая строка имеет знак +

0 голосов
/ 27 марта 2020

Я - пользователь VB, которому нужно go назад и попытаться заставить код VBA работать в Word. У меня есть файл .dotm, который содержит таблицы и данные, которые пользовательская форма "пылесосит" при инициализации. Клиент запускает свой собственный документ и может вставить «начальные таблицы», скопированные из моего .dotm. В этих таблицах пользователь идет к пустой ячейке и выбирает кнопку из пользовательской формы, чтобы вставить текст в эту ячейку. Если текст, связанный с кнопкой, имеет знак плюс, я хочу разделить ячейку, в которой находится пользователь, и разделить строку так, чтобы один фрагмент находился в «исходной» ячейке, а другой - во вновь созданном с помощью разделения клетка. У меня есть код для разделения выбранной пользователем ячейки, но у меня возникают проблемы со ссылкой на исходную ячейку и вновь созданную ячейку. Вот код, адаптированный для чего-то похожего для разделения: 

Public Sub SelectionInfo(ByVal RememberMyText As String)
     '
    Dim iSelectionRowEnd As Integer
    Dim iSelectionRowStart As Integer
    Dim iSelectionColumnEnd As Integer
    Dim iSelectionColumnStart As Integer
    Dim lngStart As Long
    Dim lngEnd As Long
     Dim numberOfColumnsInCurrentTable As Integer
        Dim currentTableIndex As Integer

     ' Check if Selection IS in a table
     ' if not, exit Sub after message
    If Selection.Information(wdWithInTable) = False Then
        MsgBox "Selection is not in a table.  Exiting macro."
    Else

        currentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
        NumberOfColumns = ActiveDocument.Tables(currentTableIndex).Columns.Count
        MsgBox ("Current table is # " & currentTableIndex)


        lngStart = Selection.Range.Start
        lngEnd = Selection.Range.End

         ' get the numbers for the END of the selection range
        iSelectionRowEnd = Selection.Information(wdEndOfRangeRowNumber)
        iSelectionColumnEnd = Selection.Information(wdEndOfRangeColumnNumber)

         ' collapse the selection range
        Selection.Collapse Direction:=wdCollapseStart

         ' get the numbers for the END of the selection range
         ' now of course the START of the previous selection
        iSelectionRowStart = Selection.Information(wdEndOfRangeRowNumber)
        iSelectionColumnStart = Selection.Information(wdEndOfRangeColumnNumber)

         ' RESELECT the same range
        Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - lngStart

         ' display the range of cells covered by the selection
        MsgBox "The selection covers " & Selection.Cells.Count & " cells, from Cell(" & _
        iSelectionRowStart & "," & iSelectionColumnStart & ") to Cell(" & _
        iSelectionRowEnd & "," & iSelectionColumnEnd & ")."

        Dim counter As Integer
        counter = 0

        For j = 1 To Len(RememberMyText)
            If Mid(RememberMyText, j, 1) = "+" Or Mid(RememberMyText, j, 1) = "-" Then
                counter = counter + 1
            End If
        Next j
        If counter > 0 Then
            MsgBox ("There were " & counter & " symbols..")
            'ActiveDocument.SelectionTables(1).Cell(iSelectionRowStart, iSelectionColumnStart).Split Numrows:=1, NumColumns:=2, MergeBeforeSplit:=False

            'ActiveDocument.SelectionTables(1).Cell(iSelectionRowStart, iSelectionColumnStart).Range.Select
            If counter = 1 Then
            Selection.Cells.Split Numrows:=1, NumColumns:=2, Mergebeforesplit:=True 'False
            'now split the text and redistribute it into the two cells, same row, different column for other half of original string

            Dim Result() As String
            Result() = Split(RememberMyText)
            Dim rng As Range
            rng = ActiveDocument.Tables(currentTableIndex).Rows(iSelectionRowStart).Cells(iSelectionColumnStart).Range
            'also tried: rng = ActiveDocument.Tables(currentTableIndex).Cells(iSelectionRowStart,iSelectionColumnStart).Range
            Selection.TypeText ("")
            Selection.TypeText (Result(0))
            rng = ActiveDocument.Tables(currentTableIndex).Rows(iSelectionRowStart).Cells(iSelectionColumnStart + 1).Range
            'also tried: rng = ActiveDocument.Tables(currentTableIndex).Cells(iselectionRowStart,iSelectionColumnStart + 1).Range
            Selection.TypeText (Result(1))


            ElseIf counter = 2 Then
            Selection.Cells.Split Numrows:=1, NumColumns:=3, Mergebeforesplit:=True 'False ' also switched true and false
'still working on this one, it would be the same issue.
            End If


        End If


    End If
End Sub

Ячейка разделяется ОК, оставляя исходный текст в одной ячейке, и вновь созданная ячейка пуста. Я просто хочу «сделать заново» эти две ячейки (или заново сделать три ячейки, если в исходной строке два знака плюс). Я просто человек среднего уровня; любая помощь с благодарностью. Спасибо

1 Ответ

0 голосов
/ 27 марта 2020

Попробуйте: 

Public Sub SelectionInfo(ByVal RememberMyText As String)
Application.ScreenUpdating = False
Dim Rng As Range, StrAddr As String, i As Long, j As Long
With Selection
  Set Rng = .Range
  ' Check if Selection IS in a table. If not, exit after message
  If .Information(wdWithInTable) = True Then
    StrAddr = "The selected cell"
    If .Cells.Count = 1 Then
      StrAddr = StrAddr & " address is: "
    Else
      StrAddr = StrAddr & "s span: "
    End If
    StrAddr = StrAddr & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex
    If .Cells.Count > 1 Then
      StrAddr = StrAddr & ":" & ColAddr(.Characters.Last.Cells(1).ColumnIndex) & _
        .Characters.Last.Cells(1).RowIndex
    End If
    StrAddr = StrAddr & " of Table: " & _
      ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
    MsgBox StrAddr
    RememberMyText = Replace(Replace(RememberMyText, "+", "¶"), "-", "¶")
    j = UBound(Split(RememberMyText, "?"))
    If j > 0 Then
      'create new cells
      Rng.Cells(1).Split Numrows:=1, NumColumns:=j + 1
    End If
    'now split the text and redistribute it into the cells
    For i = 0 To j
      Rng.Cells(i + 1).Range.Text = Split(RememberMyText, "¶")(i)
    Next
  Else
      MsgBox "Selection is not in a table.  Exiting macro."
  End If
End With
Application.ScreenUpdating = True
End Sub

Function ColAddr(i As Long) As String
If i > 26 Then
  ColAddr = Chr(64 + Int(i / 26)) & Chr(64 + (i Mod 26))
Else
  ColAddr = Chr(64 + i)
End If
End Function
...