comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

Como Exportar de Flexgrid a Excel

  • 0 Respuestas
  • 1938 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Conectado ANTRAX

  • *
  • Administrator
  • Mensajes: 5320
  • Actividad:
    41.67%
  • Reputación 29
  • ANTRAX
    • Ver Perfil
    • Underc0de
    • Email
  • Skype: underc0de.org
  • Twitter: @Underc0de
« en: Julio 26, 2010, 12:18:37 pm »
como exportar un arhivo a excel, usando un MsFlexgrid O MsHflexgrid, bueno consegui este codigo y uso el MSHFlexGrid, pero lo pueden cambiar a MSFlexGrid, sin ningun problema..

Código: Visual Basic
  1. Sub CopyToExcel(InFlexGrid As MSHFlexGrid, Nome$, _
  2.                            ByVal TextoAdicional$)
  3.   Dim R%, c%, Buf$, LstRow%, LstCol%
  4.   Dim FormatMoney As Boolean
  5.   Dim MyExcel As Excel.Application
  6.   Dim wbExcel As Excel.Workbook
  7.   Dim shExcel As Excel.Worksheet
  8.   On Error Resume Next
  9.  
  10.   Set MyExcel = GetObject(, "Excel.Application")
  11.   If Err.Number <> 0 Then
  12.         Set MyExcel = CreateObject("Excel.Application")
  13.   End If
  14.   Set wbExcel = MyExcel.Workbooks.Add
  15.   Set shExcel = wbExcel.Worksheets.Add
  16.   shExcel.Name = Nome$
  17.   shExcel.Activate
  18.   LstCol% = 0
  19.   For c% = 0 To InFlexGrid.Cols - 1
  20.         InFlexGrid.Col = c%
  21.         LstRow% = 0
  22.         shExcel.Columns(Chr(Asc("A") + c%)).ColumnWidth = InFlexGrid.ColWidth(c%) / 72
  23.         For R% = 0 To InFlexGrid.Rows - 1
  24.           InFlexGrid.Row = R%
  25.           Err.Clear
  26.           Buf$ = InFlexGrid.TextMatrix(R%, c%)
  27.           If Buf$ <> "" Then
  28.                 FormatMoney = False
  29.                 If InStr(Buf$, vbCrLf) Then
  30.                   Buf$ = StrTran(Buf$, vbCrLf, vbLf)
  31.                   Do While Right(Buf$, 1) = vbLf
  32.                         Buf$ = Left(Buf$, Len(Buf$) - 1)
  33.                   Loop
  34.                   shExcel.Range(Chr(Asc("A") + c%)).WrapText = True
  35.                 ElseIf Format(CDbl(Buf$), csFormatMoneyZero) = Buf$ Then
  36.                   If Err.Number = 0 Then
  37.                         Buf$ = Str(CDbl(Buf$))
  38.                         FormatMoney = True
  39.                   End If
  40.                 End If
  41.                 If Buf$ <> "" Then
  42.                   If InFlexGrid.MergeRow(R%) Then
  43.                         For LstCol% = c% To 1 Step -1
  44.                           If InFlexGrid.TextMatrix(R%, LstCol% - 1) <> InFlexGrid.TextMatrix(R%, c%) Then
  45.                                 Exit For
  46.                           End If
  47.                         Next
  48.                         If LstCol% <> c% Then
  49.                           shExcel.Range(Chr(Asc("A") + LstCol%) & (R% + 1), _
  50.                                                    Chr(Asc("A") + c%) & (R% + 1)).MergeCells = True
  51.                           shExcel.Range(Chr(Asc("A") + LstCol%) & (R% + 1), _
  52.                                                    Chr(Asc("A") + c%) & (R% + 1)).BorderAround
  53.                         End If
  54.                   End If
  55.                   If InFlexGrid.MergeCol(c%) And LstRow% <> R% Then
  56.                         If InFlexGrid.TextMatrix(LstRow%, c%) = InFlexGrid.TextMatrix(R%, c%) Then
  57.                           shExcel.Range(Chr(Asc("A") + c%) & (LstRow% + 1), _
  58.                                                    Chr(Asc("A") + c%) & (R% + 1)).MergeCells = True
  59.                           shExcel.Range(Chr(Asc("A") + c%) & (LstRow% + 1), _
  60.                                                    Chr(Asc("A") + c%) & (R% + 1)).BorderAround
  61.                         Else
  62.                           LstRow% = R%
  63.                         End If
  64.                   End If
  65.                   shExcel.Range(Chr(Asc("A") + c%) & _
  66.                                            (R% + 1)).Font.Color = InFlexGrid.CellForeColor
  67.                   If R% < InFlexGrid.FixedRows Or c% < InFlexGrid.FixedCols Then
  68.                         shExcel.Range(Chr(Asc("A") + c%) & _
  69.                                                  (R% + 1)).Font.Bold = True
  70.                          shExcel.Range(Chr(Asc("A") + c%) & _
  71.                                                   (R% + 1)).Font.BackColor = 40
  72.                   End If
  73.                   shExcel.Range(Chr(Asc("A") + c%) & (R% + 1)).Value = Buf$
  74.                   If FormatMoney Then
  75.                         shExcel.Range(Chr(Asc("A") + c%) & _
  76.                                                  (R% + 1)).NumberFormat = "#,##0.00;#,##0.00;#,##0.00"
  77.                   End If
  78.                 End If
  79.           End If
  80.         Next
  81.   Next
  82.   If TextoAdicional$ <> "" Then
  83.         ' shExcel.Rows(Str(r%+2)).Delete (xlShiftUp)
  84.         Do While Right(TextoAdicional$, 1) = vbLf
  85.           TextoAdicional$ = Left(TextoAdicional$, _
  86.                                             Len(TextoAdicional$) - 1)
  87.         Loop
  88.         shExcel.Range("A" & (R% + 2)).Value = TextoAdicional$
  89.   End If
  90.   MyExcel.Visible = True
  91.   Set shExcel = Nothing
  92.   Set wbExcel = Nothing
  93.   Set MyExcel = Nothing
  94. End Sub
  95. Public Function StrTran(Cadena As String, Buscar As String, Sustituir As String, Optional Veces As Variant) As String
  96.    Dim Contador As Integer
  97.  
  98. Dim Resultado As String
  99.    Dim Cambios As Integer
  100.  
  101.  
  102.    Resultado = ""
  103.    Cambios = 0
  104.  
  105.    For Contador = 1 To Len(Cadena)
  106.           If Mid(Cadena, Contador, Len(Buscar)) = Buscar Then
  107.                
  108. Resultado = Resultado & Sustituir
  109.                  If Len(Buscar) > 1 Then
  110.                    
  111. Contador = Contador + Len(Buscar) - 1
  112.                  End If
  113.                
  114.  
  115.                  ' si se especifica un nº de cambios determinados
  116.                  If Not IsMissing(Veces) Then
  117.                    
  118. Cambios = Cambios + 1
  119.                         If Cambios = Veces Then
  120.                          
  121. Resultado = Resultado & Mid(Cadena, Contador + 1)
  122.                          
  123. Exit For
  124.                    
  125. End If
  126. End If
  127.                  If Len(Buscar) > 1 Then
  128.                    
  129. Contador = Contador + Len(Buscar) - 1
  130.                  End If
  131.          
  132. Else
  133.                  Resultado = Resultado & Mid(Cadena, Contador, 1)
  134.           End If
  135.    Next
  136.  
  137.    StrTran = Resultado
  138. End Function
« Última modificación: Mayo 12, 2014, 03:11:49 pm por Expermicid »


 

¿Te gustó el post? COMPARTILO!



Como leer caracter por caracter de una cadena string

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1328
Último mensaje Julio 26, 2010, 11:42:21 am
por ANTRAX
Cómo ajustar la cadena introducida a formato de hora "00:00:00"

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1418
Último mensaje Julio 26, 2010, 12:36:23 pm
por ANTRAX
Cómo ajustar la cadena introducida a formato numérico: "#,##"

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1111
Último mensaje Julio 26, 2010, 12:38:04 pm
por ANTRAX
Manual de como bloquear CTRL+ALT+SUP, ALT+TAB, Y OTROS con Visual Basic en WinXP

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1748
Último mensaje Julio 26, 2010, 11:11:14 am
por ANTRAX
Como saber cuantos registros tiene el Recordset

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2882
Último mensaje Julio 26, 2010, 11:18:21 am
por ANTRAX