复制到foxpro中的Excel表格

时间：2016-07-25 08:15:32

标签： visual-foxpro

他们在Foxpro中的任何命令都将DBF转换为特定的Excel工作表。 我有三个DBF（dbf_1，dbf_2，dbf_3）。我当前的程序使用 copy将文件转换为“filename.xls”类型fox2x ，然后我将手动复制将所有工作表合并为一个excel。对我来说，我使用的这种方法是好的，但是如果它们是20或更多的dbf我将巩固。他们在foxpro中的任何命令都将dbf转换为一个excel文件。我已经使用了foxpro自动化，但速度很慢。

3 个答案:

答案 0 :(得分：3)

不，没有。

同时＆＃34;复制到...键入fox2x＆＃34;。虽然有更好的方法，但不应选择比许多其他类型选择（例如csv和xls）更好的选择。

您说自动化很慢，但不知道您是否真的发现自动化速度很慢，或者您是否以不应该使用的方式将数据传输到Excel。下面的示例使用我的＆＃34; vfp2excel＆＃34;的变体之一。功能和自动化。它可在2.5秒内在我的机器上传输样本客户，员工，订单，订单和产品数据。如果你真的认为它很慢，那么没有骰子，否则这里是样本：

 * These represent complex SQL as a sample
Select emp_id,First_Name,Last_Name,;
    Title,Notes ;
    from (_samples+'\data\employee') ;
    into Cursor crsEmployee ;
    readwrite
Replace All Notes With Chrtran(Notes,Chr(13)+Chr(10),Chr(10))

Select cust_id,company,contact,Title,country,postalcode ;
    from (_samples+'\data\customer') ;
    into Cursor crsCustomer ;
    nofilter

Select * ;
    from (_samples+'\data\orders') ;
    into Cursor crsOrders ;
    nofilter

Select * ;
    from (_samples+'\data\orditems') ;
    into Cursor crsOrderDetail ;
    nofilter

Select * ;
    from (_samples+'\data\products') ;
    into Cursor crsProducts ;
    nofilter

* Now we want to get these on 3 sheets
* Sheet1: Employees only
* Sheet2: Customers only
* Sheet3: Orders, ordItems, Products layed out horizontally

Local oExcel
oExcel = Createobject("Excel.Application")
With oExcel
    .DisplayAlerts = .F.
    .Workbooks.Add
    .Visible = .T.
    With .ActiveWorkBook
        For ix = 1 To 3 && We want 3 Sheets
            If .sheets.Count < m.ix
                .sheets.Add(,.sheets(.sheets.Count)) && Add new sheets
            Endif
        Endfor
        * Name the sheets
        .WorkSheets(1).Name = "Employees"
        .WorkSheets(2).Name = "Customers"
        .WorkSheets(3).Name = "Order, OrderDetail, Products" && max sheetname is 31 chars

        * Start sending data
        * First one has headers specified
        VFP2Excel('crsEmployee',    .WorkSheets(1).Range("A1"), ;
            "Id,First Name,Last Name,Employee Title,Comments about employee" ) && To sheet1, start at A1
        VFP2Excel('crsCustomer',    .WorkSheets(2).Range("A1") ) && To sheet2, start at A1
        VFP2Excel('crsOrders',      .WorkSheets(3).Range("A1") ) && To sheet3, start at A1
        * Need to know where to put next
        * Leave 2 columns empty - something like 'G1'
        lcRange = _GetChar(.WorkSheets(3).UsedRange.Columns.Count + 3) + '1'
        * To sheet3, start at next to previous
        VFP2Excel('crsOrderDetail', .WorkSheets(3).Range(m.lcRange) )

        lcRange = _GetChar(.WorkSheets(3).UsedRange.Columns.Count + 3) + '1'
        * To sheet3, start at next to previous
        VFP2Excel('crsProducts',    .WorkSheets(3).Range(m.lcRange) )

        #Define xlJustify                                         -4130
        #Define xlTop                                             -4160

        * I just happen to know notes in at column 5 from SQL
        * No need to query from excel to keep code simple
        * Lets format that column specially instead of leaving
        * at the mercy of Excel's autofitting
        .WorkSheets(1).UsedRange.VerticalAlignment = xlTop && set all to top
        With .WorkSheets(1).Columns(5)
            .ColumnWidth = 80 && 80 chars width
            .WrapText = .T.
            *      .HorizontalAlignment = xlJustify && doesn't work good always
        Endwith

        * Finally some cosmetic stuff
        For ix=1 To 3
            With .WorkSheets(m.ix)
                .Columns.AutoFit
                .Rows.AutoFit
            Endwith
        Endfor

        .WorkSheets(1).Activate
    Endwith
Endwith


* Author: Cetin Basoz
* This is based on earlier VFP2Excel function codes
* that has been published on the internet, at various sites
* since 2001. Not to be messed with others' code who named the same but has
* nothing to do with the approaches taken here (unless copy & pasted and claimed
* to be their own work, < s > that happens).
Procedure VFP2Excel(tcCursorName, toRange, tcHeaders, tnPrefferredWidthForMemo)
    * tcCursorName
    * toRange
    * tcHeaders: Optional. Defaults to field headers
    * tnPrefferredWidthForMemo: Optional. Default 80
    * Function VFP2Excel
    tcCursorName = Evl(m.tcCursorName,Alias())
    tnPrefferredWidthForMemo = Evl(m.tnPrefferredWidthForMemo,80)
    Local loConn As AdoDB.Connection, loRS As AdoDB.Recordset,;
        lcTemp,lcTempDb, oExcel,ix, lcFieldName, lcHeaders

    lnSelect = Select()
    lcTemp   = Forcepath(Sys(2015)+'.dbf',Sys(2023))
    lcTempDb = Forcepath(Sys(2015)+'.dbc',Sys(2023))

    Create Database (m.lcTempDb)
    Select * From (m.tcCursorName) Into Table (m.lcTemp) Database (m.lcTempDb)

    Local Array aMemo[1]
    Local nMemoCount
    nMemoCount = 0
    lcHeaders = ''
    For ix = 1 To Fcount()
        lcFieldName = Field(m.ix)
        If Type(Field(m.ix))='M'
            nMemoCount = m.nMemoCount + 1
            Dimension aMemo[m.nMemoCount]
            aMemo[m.nMemoCount] = m.ix
            Replace All &lcFieldName With Chrtran(&lcFieldName,Chr(13)+Chr(10),Chr(10))
        Endif
        lcHeaders = m.lcHeaders + Iif(Empty(m.lcHeaders),'',',')+Proper(m.lcFieldName)
    Endfor
    tcHeaders = Evl(m.tcHeaders,m.lcHeaders)

    Use In (Juststem(m.lcTemp))
    Close Databases
    Set Database To

    loStream = Createobject('AdoDb.Stream')
    loConn = Createobject('ADODB.Connection')
    loRS = Createobject("ADODB.Recordset")
    loConn.ConnectionString = "Provider=VFPOLEDB;Data Source="+m.lcTempDb
    loConn.Open()
    loRS = loConn.Execute("select * from "+m.lcTemp)
    loRS.Save( loStream )
    loRS.Close
    loConn.Close
    Erase (m.lcTemp)

    * Use first row for headers
    Local Array aHeader[1]

    loRS.Open( loStream )
    toRange.Offset(1,0).CopyFromRecordSet( loRS )  && Copy data starting from headerrow + 1

    Set Safety Off
    Delete Database (m.lcTempDb) Deletetables

    Select (m.lnSelect)

    For ix=1 To Iif( !Empty(m.tcHeaders), ;
            ALINES(aHeader, m.tcHeaders,1,','), ;
            loRS.Fields.Count )
        toRange.Offset(0,m.ix-1).Value = ;
            Iif( !Empty(m.tcHeaders), ;
            aHeader[m.ix], ;
            Proper(loRS.Fields(m.ix-1).Name) )
        toRange.Offset(0,m.ix-1).Font.Bold = .T.
    Endfor

    #Define xlJustify                                         -4130
    #Define xlTop                                             -4160
    * This part is cosmetic
    toRange.WorkSheet.Activate
    With toRange.WorkSheet.UsedRange
        .VerticalAlignment = xlTop && set all to top
        For ix=1 To m.nMemoCount
            With .Columns(aMemo[m.ix])
                .ColumnWidth = m.tnPrefferredWidthForMemo && 80 chars width
                .WrapText = .T.
            Endwith
        Endfor
        .Columns.AutoFit
        .Rows.AutoFit
    Endwith
Endproc

* Return A, AA, BC etc noation for nth column
Function _GetChar
    Lparameters tnColumn && Convert tnvalue to Excel alpha notation
    If m.tnColumn = 0
        Return ""
    Endif
    If m.tnColumn <= 26
        Return Chr(Asc("A")-1+m.tnColumn)
    Else
        Return  _GetChar(Int(Iif(m.tnColumn % 26 = 0,m.tnColumn - 1, m.tnColumn) / 26)) + ;
            _GetChar((m.tnColumn-1)%26+1)
    Endif
Endfunc

答案 1 :(得分：0)

这就是我要找的:-)我正在尝试用 Visual FoxPro 中的 Excel Automation 编程知识，但总是遇到错误。我的任务是创造＆＃34; n＆＃34;来自一个大游标的表格，我想要解析客户从光标中选择属性名称，以及“＃34; n＆＃34;表。此示例适用于3个光标和3个表格，它是通用的。但我需要这个＆＃34; n＆＃34;客户选择以区分和获取＆＃34; n＆＃34; 和 一个属性表格在一个 Excel文件中。所以现在我有动态程序。我定制了这个代码并解决了我试图结束大约4天的问题。所以再次感谢您使用此代码，当然我不会修改 VFP2Excel 程序并在其他地方写下我的名字。谢谢你的帮助！

答案 2 :(得分：0)

没有原生 VFP功能可以做到这一点，但是，有一个很棒的开源项目，它有一个类可以让这很容易：

VFPx练习册Xlsx - 在Github上查看：XLSX Workbook for FoxPro

它有3个神奇的功能，可以完全满足您的要求：

  • CreateWorkbook（）
  • AddSheet（）
  • SaveTableToWorkbook（）

（对于您要创建的每个DBF / Sheet，重复上面的命令2和3）

54页的PDF和代码示例详细记录了您需要了解的所有内容。

相关问题
最新问题