- Public Function MText_Unformat(ByVal sTxt As String) As String'------------------------------------------------------------------------------'Remove formatting strings''Value Examples:' \A Sets the alignment value; valid values: 0, 1, 2 (bottom, center, top)' \Cvalue; Changes to the specified color' \Hvalue; Changes to the specified text height' \Hvaluex; Changes to multiple of mtext object's property' \L...\l Turns underline on and off' \O...\o Turns overline on and off' \P Ends paragraph/Carriage return' \Qangle; Changes obliquing angle' \S...^...; Stacks the subsequent text at the \ or ^ symbol' \Tvalue; Adjusts the space between characters' \Wvalue; Changes width factor to produce wide text' \~ Inserts a nonbreaking space' \\ Inserts a backslash' \{...\} Inserts an opening and closing brace' \File name; Changes to the specified font file''------------------------------------------------------------------------------Dim P1 As IntegerDim P2 As IntegerDim P3 As IntegerDim iStart As IntegerDim sComp As StringDim sReplace As StringDim sLittle As String'''''''''''''''''''''''''''''''''''''''Debug.Print sTxt'------------------------------------------------------------------------------'Remove alignment codes'------------------------------------------------------------------------------Select Case Left(sTxt, 4)Case "\A0;", "\A1;", "\A2;" sTxt = Mid(sTxt, P1 + 5)End SelectiStart = 1'------------------------------------------------------------------------------'Replace octal code values with strings'------------------------------------------------------------------------------Do P1 = InStr(sTxt, "%%") If P1 = 0 Then Exit Do Else Select Case Mid(sTxt, P1 + 2, 1) Case "P" sTxt = Replace(sTxt, "%%P", "+or-") Case "D" sTxt = Replace(sTxt, "%%D", " deg") End Select End IfLoopDo P1 = InStr(iStart, sTxt, "", vbTextCompare) If P1 = 0 Then Exit Do sComp = Mid(sTxt, P1, 2) Select Case sComp Case "\p" P2 = InStr(1, sTxt, ";") sTxt = Mid(sTxt, P2 + 1) Case "\A", "\C", "\f", "\F", "\H", "\Q", "\T", "\W" P2 = InStr(P1 + 2, sTxt, ";", vbTextCompare) P3 = InStr(P1 + 2, sTxt, sComp, vbTextCompare) If P3 = 0 Then sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P2 + 1) End If Do While P3 > 0 P2 = InStr(P3, sTxt, ";", vbTextCompare) sTxt = Left(sTxt, P3 - 1) & Mid(sTxt, P2 + 1) 'Debug.Print sTxt, sComp P3 = InStr(1, sTxt, sComp, vbTextCompare) Loop 'sTxt = Left(sTxt, P3 - 1) & mid(sTxt, P3 + 1) Case "\L", "\O" sLittle = LCase(sComp) P2 = InStr(P1 + 2, sTxt, sLittle, vbTextCompare) If P2 = 0 Then sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P1 + 2) Else sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P1 + 2, P2 - (P1 + 2)) & Mid(sTxt, P2 + 2) End If Case "\S" P2 = InStr(P1 + 2, sTxt, ";", vbTextCompare) P3 = InStr(P1 + 2, sTxt, "/", vbTextCompare) If P3 = 0 Or P3 > P2 Then P3 = InStr(P1 + 2, sTxt, "#", vbTextCompare) End If If P3 = 0 Or P3 > P2 Then P3 = InStr(P1 + 2, sTxt, "^", vbTextCompare) End If sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P1 + 2, P3 - (P1 + 2)) _ & "/" & Mid(sTxt, P3 + 1, (P2) - (P3 + 1)) & Mid(sTxt, P2 + 1) Case "\U" 'Replace symbols with text sLittle = Mid(sTxt, P1 + 3, 4) Debug.Print sLittle Select Case sLittle Case "2248" sReplace = "ALMOST EQUAL" Case "2220" sReplace = "ANGLE" Case "2104" sReplace = "CENTER LINE" Case "0394" sReplace = "DELTA" Case "0278" sReplace = "ELECTRIC PHASE" Case "E101" sReplace = "FLOW LINE" Case "2261" sReplace = "IDENTITY" Case "E200" sReplace = "INITIAL LENGTH" Case "E102" sReplace = "MONUMENT LINE" Case "2260" sReplace = "NOT EQUAL" Case "2126" sReplace = "OHM" Case "03A9" sReplace = "OMEGA" Case "214A" sReplace = "PROPERTY LINE" Case "2082" sReplace = "SUBSCRIPT2" Case "00B2" sReplace = "SQUARED" Case "00B3" sReplace = "CUBED" End Select sTxt = Replace(sTxt, "\U+" & sLittle, sReplace) Case "\~" sTxt = Replace(sTxt, "\~", " ") Case "\" iStart = P1 + 2 sTxt = Replace(sTxt, "\", "") GoTo Selectagain Case "\P" iStart = P1 + 1 GoTo Selectagain Case Else Exit Do End SelectSelectagain:Loop'------------------------------------------------------------------------------'Replace \P with vbCrLf'------------------------------------------------------------------------------Do P1 = InStr(1, sTxt, "\P", vbTextCompare) If P1 = 0 Then Exit Do Else sTxt = Left(sTxt, P1 - 1) & vbCrLf & Mid(sTxt, P1 + 2) End IfLoopFor iStart = 0 To 1 If iStart = 0 Then sComp = "}" Else sComp = "{" End If P2 = InStr(1, sTxt, sComp) Do While P2 > 0 sTxt = Left(sTxt, P2 - 1) & Mid(sTxt, P2 + 1) P2 = InStr(1, sTxt, sComp) LoopNext iStartMText_Unformat = sTxtEnd Function
置顶卡
