CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 2 of 2
  1. #1
    Join Date
    Mar 2013
    Posts
    17

    Coding shows "Type mismatch" error

    One of my friend has created a below coding for me.

    Code:
    Sub Demo()
        Dim i As Long, j As Long, k As Long, t As Single, SngFnt As Single, ArrWdth() As Single
        Dim ArrChr As String, StrTmp As String, StrTxt As String, StrFnd As String, StrRep As String
         'String Array. As coded, holds character widths for 10pt Arial.
        ArrChr = "   2.50 ! 3.35 " & Chr(34) & "4.10 # 5.00 $ 5.00 % 8.25 & 7.75 ' 1.75 ( 3.35 ) 3.35 " & _
        "* 5.00 + 5.60 , 2.55 - 3.35 . 2.55 / 2.80 0 5.00 1 5.00 2 5.00 3 5.00 4 5.00 5 5.00 " & _
        "6 5.00 7 5.00 8 5.00 9 5.00 : 2.80 ; 2.80 < 5.60 = 5.60 > 5.60 ? 4.45 @ 9.15 A 7.20 " & _
        "B 6.65 C 6.65 D 7.20 E 6.10 F 5.55 G 7.20 H 7.20 I 3.35 J 3.90 K 7.20 L 6.10 M 8.85 " & _
        "N 7.20 O 7.20 P 5.55 Q 7.20 R 6.65 S 5.55 T 6.10 U 7.20 V 7.20 W 9.45 X 7.20 Y 7.20 " & _
        "Z 6.10 [ 3.35 \ 2.75 ] 3.35 ^ 4.70 _ 5.00 ` 3.35 a 4.45 b 5.00 c 4.45 d 5.00 e 4.45 " & _
        "f 3.35 g 5.00 h 5.00 i 2.80 j 2.80 k 5.00 l 2.80 m 7.75 n 5.00 o 5.00 p 5.00 q 5.00 " & _
        "r 3.35 s 3.90 t 2.80 u 5.00 v 5.00 w 7.20 x 5.00 y 5.00 z 4.45 { 4.80 | 1.95 } 4.80 ~ 5.45 "
         'Input the font size & divide by 10 for scaling the output
        SngFnt = 12 / 10
         'Initialize the output String-width array
        ReDim Preserve ArrWdth(1)
         'Initialize the Find String
        StrFnd = "(^13*)"
        With ActiveDocument.Range
             ' Loop through all paragraphs
            For i = 1 To .Paragraphs.Count
                 'Get the paragraph text, minus the paragraph marker
                StrTmp = .Paragraphs(i).Range.Text
                StrTmp = Left(StrTmp, Len(StrTmp) - 1)
                 'Redim the output String-width array, as necessary
                If UBound(Split(StrTmp, vbTab)) > UBound(ArrWdth) Then
                    ReDim Preserve ArrWdth(UBound(Split(StrTmp, vbTab)))
                End If
                 'Process each tab-separated block, ignoring the first one
                For j = 1 To UBound(Split(StrTmp, vbTab))
                    StrTxt = Split(StrTmp, vbTab)(j)
                     'If there's a decimal number, trim to the last digit
                    'If InStr(StrTxt, ".") > 0 Then
                     If StrTxt Like "*.[0-9]*" Then
                      While Not IsNumeric(Right(StrTxt, 1))
                            StrTxt = Left(StrTxt, Len(StrTxt) - 1)
                        Wend
                    End If
                     'Calculate the string width, based on a 10pt font
                    t = 0
                    For k = 1 To Len(StrTxt)
                        t = t + Split(Split(ArrChr, " " & Mid(StrTxt, k, 1) & " ")(1), " ")(0)
                    Next
                     'Re-scale the calculation for the required point size
                    t = t * SngFnt
                     'Update the output String-width array
                    If t > ArrWdth(j) Then ArrWdth(j) = t
                Next
            Next
             'Parse the string to be updated
            'StrTmp = Split(.Paragraphs.First.Range.Text, vbTab)(0)
             For i = 1 To .Paragraphs.Count
         If UBound(Split(.Paragraphs(i).Range.Text, vbTab)) = UBound(ArrWdth) Then
                      'Parse the string to be updated
                  StrTmp = Split(.Paragraphs(i).Range.Text, vbTab)(0)
            Exit For
         End If
    Next
             'Split at ',")'
            j = UBound(Split(StrTmp, Chr(44) & Chr(148) & ")")) - 1
            For i = 0 To j
                StrTxt = Split(StrTmp, Chr(44) & Chr(148) & ")")(i)
                If i = 0 Then
                     'For the first item, re-split at '('
                    StrTxt = Right(StrTxt, Len(StrTxt) - InStrRev(StrTxt, "("))
                Else
                     'For the remaining items, re-split at '"'
                    StrTxt = Right(StrTxt, Len(StrTxt) - InStrRev(StrTxt, Chr(147)))
                End If
                 'Update the Find expression
                StrFnd = StrFnd & StrTxt & "(*)"
            Next
             'Finalize the Find string
            StrFnd = Left(StrFnd, Len(StrFnd) - 3) & "([!^13]{1,})"
             'Add the 'master' width to the output String-width array
            ReDim Preserve ArrWdth(j + 2)
            ArrWdth(j + 2) = StrTxt
             'Re-calculate the output String-width array elements
            For i = UBound(ArrWdth) - 1 To 0 Step -1
                ArrWdth(i) = ArrWdth(i + 1) - ArrWdth(i) - 10
            Next
             'Generate the Replace string
            For i = 1 To UBound(ArrWdth) - 1
                StrRep = StrRep & "\" & i & Round(ArrWdth(i + 1), 0)
            Next
             'Finalize the Replace string
            StrRep = StrRep & "\" & i
             'Add a temporary paragraph at the start of the document
            .InsertBefore vbCr
             'Update the document
            With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchWildcards = True
                .Text = StrFnd
                .Replacement.Text = StrRep
                .execute replace:=wdReplaceAll
            End With
             'Delete the temporary paragraph at the start of the document
            .Characters.First = vbNullString
        End With
    End Sub
    The macro do the following.
    1. Find out each and every character width from the Tab Delimited Text from the given Array. Character width is calculated (From Tab upto the numeric value except the hanging characters i.e., “)”, “*”, “%” etc.,)
    2. Find out the maximum width of the each column.
    3. Minus it with the values which is available on the Starting of the Paragraph and
    4. Replace the Value

    Coding Runs from the last column to the first column.


    But the macro throws “Type mismatch” error (Highlighted in the Coding). At present I am unable to contact my friend.

    I doesn’t know Visual Basic.

    So if any one fix this Error. It will be greatly appreciated.

    Sample data attached for your reference

    Thanks in advance,
    Joe
    Attached Files Attached Files

  2. #2
    VictorN's Avatar
    VictorN is offline Super Moderator Power Poster
    Join Date
    Jan 2003
    Location
    Hanover Germany
    Posts
    20,396

    Re: Coding shows "Type mismatch" error

    Well, I am not a guru in VB, but it doesn't prevent me to look for this type of error in MSDN. For instance here:
    Type mismatch (Visual Basic)
    ...
    You attempted to convert a value to another type in a way that is not valid.
    So why do you attempt to convert String to single (which is a 32-bit float)?
    Victor Nijegorodov

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  





Click Here to Expand Forum to Full Width

Featured