是否使用VBA从PowerPoint中的文本中查找数字？ [英] find number from text in powerpoint using vba?

问题描述

我知道这个问题已经被问到了，但这里有一些不同的场景。

所以我想从整个文本区域中搜索整数。如果找到，则检查其十进制数是否大于2(例如，如果Numbers Found=13.656，则四舍五入为13.66)如果没有，则对其进行四舍五入。

因此，如果在一个文本区域中有多个整数，则它应该检查所有这些整数。

当我试图编写用于查找特定字符或数字的代码时。但我不明白如何找到整数(从0到9表示no)。

下面是我查找指定字符的代码：

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  

有没有同样的办法。

谢谢

推荐答案

我没有非常仔细地检查您的代码，但它无法工作，因为您正在搜索"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

这篇关于是否使用VBA从PowerPoint中的文本中查找数字？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！