FLEXGRID E EXCEL

USUARIO.EXCLUIDOS 12/12/2006 11:07:22
#189486
All, bom dia.
Pesquisei em todo o VBMANIA, uma forma de exportar dados de uma flexgrid para o Excel.
Encontrei um fonte excelente na seção de códigos fontes, porém, me deparei com o seguinte problema:
Minha Flex, possui 37 colunas, e a forma apresentada, exporta apenas 23 (de A até Z).

Existe alguma forma de exportar esta quantidade de colunas?

Atts
ALMARTI 12/12/2006 11:46:24
#189491
Poste o codigo de exportação. Provavelmente será algo tipo .cols = x
USUARIO.EXCLUIDOS 12/12/2006 13:32:56
#189511
Utilizo este código, que encontrei aqui no próprio VBMANIA:

'===================================================================
Public Sub SalvarNoExcel(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
Application.DisplayAlerts = False
  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

          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
USUARIO.EXCLUIDOS 15/12/2006 08:22:08
#190105
Alguém sabe como me ajudar?
Pois pelo que percebi, ao chegar na linha

shExcel.Range(Chr(Asc("A") + c%)

ele busca pelo nome da coluna

Existe outra maneira de buscar a coluna?
Pois ao chegar na coluna AA, esta apresentando erro , e o texto esta sendo adicionado novamente na coluna A
USUARIO.EXCLUIDOS 15/12/2006 09:43:15
#190120 Resposta escolhida
Indo direto ao ponto:
For c% = 0 To InFlexGrid.Cols - 1
        InFlexGrid.Col = c%
    LstRow% = 0
    shExcel.Columns(Chr(Asc("A") + c%)).ColumnWidth =


Uma idéia - para mexer o mínimo no código existente - é:
Acrescentar as variáveis:
Dim xChr1, xChr2   '*** acho impossível precisar de xChr3
Dim xQtABC          

For c% = 0 To InFlexGrid.Cols - 1
        InFlexGrid.Col = c%
    LstRow% = 0
    
    xQtABC = INT(c% /26)

    If xQtABC > 0 Then
       xChr1 = Chr(xQtABC + 64)
       xChr2 = xChr1 & Chr((C% - (26 * xQtABC)) + 65)
    Else
       xChr2 = Chr(C% + 64)
    End If

    

    shExcel.Columns(xChar2).ColumnWidth =



Experimente!
Tópico encerrado , respostas não são mais permitidas
Voltar