найти номер из текста в PowerPoint с помощью VBA?

Question

Я знаю, что этот вопрос уже задают, но здесь есть другой сценарий.

Итак, я хочу найти целое число из всей текстовой области. Если найдено, проверьте, имеет ли он десятичное число больше 2 ( например, если numberfound = 13.656, затем округлите до 13.66 ), если нет, округлите его.

поэтому, если в одной текстовой области содержится более одного целого числа, она должна проверить все из них.

Как я пытаюсь написать код для поиска конкретного символа или числа. но я не понимаю, как найти целое число (значит, нет от 0 до 9).

Ниже приведен мой код для поиска указанного символа:

Sub FindNumber()
Dim oSld As Slide
Dim oShp As Shape
Dim oShapes As Shapes
Dim TxtRng as variant 
Dim foundText as variant
Dim no(10) As Variant

For Each oSld In ActivePresentation.Slides
    Set oShapes = oSld.Shapes
    For Each oShp In oShapes
        If oShp.HasTextFrame Then
            If oShp.HasTextFrame Then
                Set TxtRng = oShp.TextFrame.TextRange
                Set foundText = TxtRng.Find(Findwhat:="0")
                sno = oSld.SlideNumber
                Do While Not (foundText Is Nothing)

                    With foundText

                        Set foundText = _
                        TxtRng.Replace(Findwhat:="0",After:=.start + .length -1 )
                    End With
                Loop
            End If
        End If
    Next oShp
Next oSld
End Sub  

Есть ли способ сделать то же самое.

Спасибо

Answer 1

Я не очень внимательно изучил ваш код, но он не может работать, потому что вы ищете "0".Число не должно содержать ноль.

Ниже я приведу функцию, которая берет строку и возвращает ее с округленными числами, как вам нужно.Назовите это в своем коде.

Я включаю свои тестовые данные.Я рекомендую вам скопировать текст из текстовых полей в эту процедуру тестирования.

Option Explicit
Sub TestRound()

  Debug.Print RoundNumbersInText("abcd efghi jklm nopq")
  Debug.Print RoundNumbersInText("ab.cd 1.23 jklm 1.2345")
  Debug.Print RoundNumbersInText("abcd 1.2345 jklm 1.2345")
  Debug.Print _
      RoundNumbersInText("1.2397 jklm 1.2397abcd 1.23.97 jklm 1.2397")
  Debug.Print RoundNumbersInText("abcd 12,345.2345 jklm 1234,5.2345")
  Debug.Print RoundNumbersInText("-1.2345 jklm 1.2345+")
  Debug.Print RoundNumbersInText("abcd -1.2345- jklm +1.2345+")
  Debug.Print RoundNumbersInText(".2345 jklm .23")
  Debug.Print RoundNumbersInText("abcd 1.23.97 jklm .1.2397abcd ")
  Debug.Print RoundNumbersInText("1.234,5 jklm 1.23,45 jklm 1.23,45,")

End Sub
Function RoundNumbersInText(ByVal InText As String) As String

  Dim ChrCrnt As String
  Dim LenInText As Long
  Dim NumberFound As Boolean
  Dim NumberStg As String
  Dim OutText As String
  Dim PosCrnt As Long
  Dim PosDecimal As Long
  Dim PosToCopy As Long

  PosToCopy = 1       ' First character not yet copied to OutText
  PosCrnt = 1
  LenInText = Len(InText)
  OutText = ""

  Do While PosCrnt <= LenInText
    If IsNumeric(Mid(InText, PosCrnt, 1)) Then
      ' Have digit.  Use of Val() considered but it would accept
      ' "12.3 456" as "12.3456" which I suspect will cause problems.
      ' A Regex solution would be better but I am using Excel 2003.
      ' For me a valid number is, for example, 123,456.789,012
      ' I allow for commas anywhere within the string not just on thousand
      ' boundaries.  I will accept one dot anywhere in a number.
      ' You may need to reverse my use of dot and comma.  Better to use
      ' Application.International(xlDecimalSeparator) and
      ' Application.International(xlThousandsSeparator).
      ' I do not look for signs.  "-12.3456" will become "-12.35".
      ' "12.3456-" will become "12.35-". "-12.3456-" will become "-12.35-".
      PosDecimal = 0        ' No decimal found
      If PosCrnt > 1 Then
        ' Check for initial digit being preceeded by dot.
        If Mid(InText, PosCrnt - 1, 1) = "." Then
          PosDecimal = PosCrnt - 1
        End If
      End If
      ' Now review following characters
      PosCrnt = PosCrnt + 1
      NumberFound = True        ' Assume OK until find otherwise
      Do While PosCrnt <= LenInText
        ChrCrnt = Mid(InText, PosCrnt, 1)
        If ChrCrnt = "." Then
          If PosDecimal = 0 Then
            PosDecimal = PosCrnt
          Else
            ' Second dot found.  This cannot be a number.
            ' Might have 12.34.5678. Do not want .5678 picked up
            ' so step past character after dot.
            PosCrnt = PosCrnt + 1
            NumberFound = False
            Exit Do
          End If
        ElseIf ChrCrnt = "," Then
          ' Accept comma and continue search.
        ElseIf IsNumeric(ChrCrnt) Then
          ' Accept digit and continue search.
        Else
          ' End of possible number
          NumberFound = True
          Exit Do
        End If
        PosCrnt = PosCrnt + 1
      Loop
      If NumberFound Then
        ' PosCrnt points at the character which ended the number.
        If Mid(InText, PosCrnt - 1, 1) = "," Then
          ' Do not include a terminating comma in number
          PosCrnt = PosCrnt - 1
        End If
        If PosDecimal = 0 Then
          ' Integer.  Nothing to do.  Carry on with search.
          PosCrnt = PosCrnt + 1     ' Step over terminating character
        Else
          ' Copy everything up to decimal
          OutText = OutText & Mid(InText, PosToCopy, PosDecimal - PosToCopy)
          PosToCopy = PosDecimal
          ' Round decimal portion even if less than two digits. Discard
          ' any commas. Round will return 0.23 so discard zero
          OutText = OutText & Mid(CStr(Round(Val(Replace(Mid(InText, _
                       PosToCopy, PosCrnt - PosToCopy), ",", "")), 2)), 2)
          PosToCopy = PosCrnt
          PosCrnt = PosCrnt + 1     ' Step over terminating character
        End If
      Else ' String starting as PosStartNumber is an invalid number
        ' PosCrnt points at the next character
        ' to be examined by the main loop.
      End If
    Else  ' Not a digit
      PosCrnt = PosCrnt + 1
    End If
  Loop
  ' Copy across trailing characters
  OutText = OutText & Mid(InText, PosToCopy)
  RoundNumbersInText = OutText

End Function

Answer 2

Это действительно комментарий, а не ответ, но комментарии не позволяют форматировать код, поэтому мы здесь.Эта часть не совсем правильная:

For Each oShp In oShapes
    If oShp.HasTextFrame Then
        If oShp.HasTextFrame Then
            Set TxtRng = oShp.TextFrame.TextRange

Вместо этого она должна быть:

For Each oShp In oShapes
    If oShp.HasTextFrame Then
        ' This is the change:
        If oShp.TextFrame.HasText Then
            Set TxtRng = oShp.TextFrame.TextRange