问题
I know this question is already ask but here is some different scenario.
So i wants to search integer from whole textarea. If found then check is it have decimals number more than 2 (e.g. if numberfound=13.656 then round off to 13.66 ) if no then round off it.
so if in one textarea there is more than one integer then it should check all of those.
As i try to write code for finding specific character or number. but i am not getting it how to find whole integer(means no from 0 To 9).
Below is my code for finding specified character :
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
Is there any way to do the same.
Thanks
回答1:
I have not examined your code very carefully but it cannot work because you are searching for "0". A number need not contain zero.
Below I give a function that takes a string and returns it with the numbers rounded as you require. Call it within your code.
I include my test data. I recommend you copy text from your text boxes into this test routine.
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
回答2:
This is really a comment rather than an answer, but comments don't allow code formatting, so here we are. This part isn't quite right:
For Each oShp In oShapes
If oShp.HasTextFrame Then
If oShp.HasTextFrame Then
Set TxtRng = oShp.TextFrame.TextRange
Instead, it should be:
For Each oShp In oShapes
If oShp.HasTextFrame Then
' This is the change:
If oShp.TextFrame.HasText Then
Set TxtRng = oShp.TextFrame.TextRange
来源：https://stackoverflow.com/questions/9098276/find-number-from-text-in-powerpoint-using-vba