使用vba从powerpoint中的文本中查找数字？

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