MSFLEXGRID EXCEL

Sub CopyToExcel(InFlexGrid As MSFlexGrid, Nome$, _
               ByVal TextoAdicional$)
  Dim R%, c%, Buf$, LstRow%, LstCol%
  Dim FormatMoney As Boolean
  Dim MyExcel As Excel.Application
  Dim wbExcel As Excel.Workbook
  Dim shExcel As Excel.Worksheet
  On Error Resume Next

  Set MyExcel = GetObject(, [Ô]Excel.Application[Ô])
  If Err.Number <> 0 Then
    Set MyExcel = CreateObject([Ô]Excel.Application[Ô])
  End If
  Set wbExcel = MyExcel.Workbooks.Add
  Set shExcel = wbExcel.Worksheets.Add
  shExcel.Name = Nome$
  shExcel.Activate
  LstCol% = 0
  For c% = 0 To InFlexGrid.Cols - 1
    InFlexGrid.Col = c%
    LstRow% = 0
    shExcel.Columns(Chr(Asc([Ô]A[Ô])+c%)).ColumnWidth=InFlexGrid.ColWidth(c%)/72
    For R% = 0 To InFlexGrid.Rows - 1
      InFlexGrid.Row = R%
      Err.Clear
      Buf$ = InFlexGrid.TextMatrix(R%, c%)
      If Buf$ <> [Ô][Ô] Then
        FormatMoney = False
        If InStr(Buf$, vbCrLf) Then
          Buf$ = StrTran(Buf$, vbCrLf, vbLf)
          Do While Right(Buf$, 1) = vbLf
            Buf$ = Left(Buf$, Len(Buf$) - 1)
          Loop
          shExcel.Range(Chr(Asc([Ô]A[Ô]) + c%)).WrapText = True
        ElseIf Format(CDbl(Buf$),csFormatMoneyZero)=Buf$ Then
          If Err.Number = 0 Then
            Buf$ = Str(CDbl(Buf$))
            FormatMoney = True
          End If
        End If
        If Buf$ <> [Ô][Ô] Then
          If InFlexGrid.MergeRow(R%)      Then
            For LstCol% = c% To 1 Step -1
              If InFlexGrid.TextMatrix(R%,LstCol%-1)<>InFlexGrid.TextMatrix(R%,c%) Then
                Exit For
              End If
            Next
            If LstCol% <> c% Then
              shExcel.Range(Chr(Asc([Ô]A[Ô])+LstCol%) & (R%+1), _
                           Chr(Asc([Ô]A[Ô])+c%) & (R%+1)).MergeCells=True
              shExcel.Range(Chr(Asc([Ô]A[Ô])+LstCol%) & (R%+1), _
                           Chr(Asc([Ô]A[Ô])+c%) & (R%+1)).BorderAround
            End If
          End If
          If InFlexGrid.MergeCol(c%) And LstRow% <> R% Then
            If InFlexGrid.TextMatrix(LstRow%,c%)=InFlexGrid.TextMatrix(R%,c%)Then
              shExcel.Range(Chr(Asc([Ô]A[Ô])+c%) & (LstRow%+1), _
                           Chr(Asc([Ô]A[Ô])+c%) & (R%+1)).MergeCells=True
              shExcel.Range(Chr(Asc([Ô]A[Ô])+c%) & (LstRow%+1), _
                           Chr(Asc([Ô]A[Ô])+c%) & (R%+1)).BorderAround
            Else
              LstRow% = R%
            End If
          End If
          shExcel.Range(Chr(Asc([Ô]A[Ô])+c%) & _
                       (R%+1)).Font.Color=InFlexGrid.CellForeColor
          If R%<InFlexGrid.FixedRows Or c%<InFlexGrid.FixedCols Then
            shExcel.Range(Chr(Asc([Ô]A[Ô])+c%) & _
                         (R%+1)).Font.Bold=True
            [ô] shExcel.Range(Chr(Asc([Ô]A[Ô])+c%) & _
            [ô]              (r%+1)).Font.BackColor = 40
          End If
          shExcel.Range(Chr(Asc([Ô]A[Ô])+c%) & (R%+1)).Value=Buf$
          If FormatMoney Then
            shExcel.Range(Chr(Asc([Ô]A[Ô])+c%) & _
                         (R%+1)).NumberFormat=[Ô]#,##0.00;#,##0.00;#,##0.00[Ô]
          End If
        End If
      End If
    Next
  Next
  If TextoAdicional$ <> [Ô][Ô] Then
    [ô] shExcel.Rows(Str(r%+2)).Delete (xlShiftUp)
    Do While Right(TextoAdicional$, 1) = vbLf
      TextoAdicional$ = Left(TextoAdicional$, _
                        Len(TextoAdicional$) - 1)
    Loop
    shExcel.Range([Ô]A[Ô] & (R% + 2)).Value = TextoAdicional$
  End If
  MyExcel.Visible = True
  Set shExcel = Nothing
  Set wbExcel = Nothing
  Set MyExcel = Nothing
End Sub