vbaを使ってパワーポイント内のテキストから番号を探しますか？

Question

私はこの質問がすでに尋ねられていることを知っていますが、ここではいくつかの異なるシナリオです。

だから私は全体のテキストエリアから整数を検索したいと思います。それが見つかった場合は、それが四捨五入されていない場合は、小数点以下2桁（、例えばnumberfound = 13.656ならば13.66に丸めます）をチェックします。

したがって、1つのテキストエリアに複数の整数がある場合は、それらのすべてをチェックする必要があります。

私は特定の文字や数字を見つけるためのコードを書こうとしています。しかし、私はそれが全体の整数（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 

同じことを行うにはどのような方法があります：

以下は指定された文字を見つけるための私のコードです。

おかげ

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