Postada em 01/06/2006 10:05 hs
Bom dia a todos Gostaria de saber como usar esta função desde ja agradeço a todos '---------------------------------------------------------------------------- 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
Ralph Teixeira
|