动态打印工资清单 - VFP论坛

第 61 楼

得分:4

回复 60楼 TonyDeng

帮鼓鼓劲

第 62 楼

得分:0

你对照下面的效果图和模板，自然知道模板怎么写，不详细说明了：

图片附件: 游客没有浏览图片的权限，请登录或注册

授人以渔，不授人以鱼。

第 63 楼

得分:0

程序代码：

CLEAR ALL
CLEAR
Main()
CLEAR ALL
RETURN 

PROCEDURE Main()
    LOCAL lcFileName, loExcel, lnRow, lnCol, lnIndex, lnRecIndex
    LOCAL lnFile, laString[1], lcBuffer
    LOCAL lnMaxRows, lnMaxCols
   
    lnMaxRows = 10
    lnMaxCols = 4
   
    lcFileName = "工资条.txt"
    IF !FILE(lcFileName)
        MESSAGEBOX("文件" + lcFileName + "不存在！", 16, "")
        RETURN
    ENDIF
    lnFile = FOPEN(lcFileName)
    IF lnFile == -1
        MESSAGEBOX("文件" + lcFileName + "打开失败！", 16, "")
        RETURN
    ENDIF
    lnIndex = 0
    DO WHILE !FEOF(lnFile)
        lnIndex = lnIndex + 1
        DIMENSION laString[lnIndex]
        laString[lnIndex] = ALLTRIM(FGETS(lnFile))
    ENDDO
    FCLOSE(lnFile)

    IF !USED("工资")
        USE test_prn ALIAS 工资 IN 0
    ENDIF
   
    lcFileName = Application.DefaultFilePath + "\工资条"
    IF FILE(lcFileName + ".xls")
        loFileName = lcFileName + ".xls"
        DELETE FILE (lcFileName)
    ELSE
        IF FILE(lcFileName + ".xlsx")
            lcFileName = lcFileName + ".xlsx"
            DELETE FILE (lcFileName)
        ENDIF
    ENDIF
   
    WAIT "正在启动 Microsoft Excel Application，请稍候……" WINDOW NOWAIT
    loExcel = CREATEOBJECT("Excel.Application")
    WAIT "正在生成工资条，请稍候……" WINDOW NOWAIT
    WITH loExcel
        .SheetsInNewWorkbook = 1
        .Workbooks.Add
        .WorkSheets(1).Activate
        lnRecIndex = 0
        SELECT 工资
        SCAN ALL
            lnRecIndex = lnRecIndex + 1
            lnRow = 1 + (lnRecIndex - 1) * lnMaxRows
            IF lnRecIndex > 1
                .ActiveSheet.Rows(1 + (lnRecIndex - 1) * lnMaxRows).PageBreak = 1
            ENDIF
            FOR lnIndex = 1 TO ALEN(laString, 1)
                lnCol = 2
                lcBuffer = laString[lnIndex]
                DO WHILE !EMPTY(lcBuffer)
                    LOCAL lcCaption, lcExpression, llBold
                    Get_Expression(Get_Unit(@lcBuffer), @lcCaption, @lcExpression, @llBold)
                    IF EMPTY(lcCaption) .AND. EMPTY(lcExpression)
                        lnCol = lnCol + 1
                    ENDIF
                    IF !EMPTY(lcExpression) .AND. !Empty(EVALUATE(lcExpression))
                        IF !EMPTY(lcCaption)
                            WITH .Cells(lnRow + lnIndex, lnCol)
                                .Value = lcCaption
                                .Font.Bold = llBold
                                .HorizontalAlignment = 3
                            ENDWITH
                            WITH .Cells(lnRow + lnIndex, lnCol + 1)
                                .Value = EVALUATE(lcExpression)
                                .Font.Bold = llBold
                                .HorizontalAlignment = 3
                            ENDWITH
                            lnCol = lnCol + 2
                        ELSE
                            WITH .Cells(lnRow + lnIndex, lnCol)
                                .Value = EVALUATE(lcExpression)
                                .Font.Bold = llBold
                                .HorizontalAlignment = 3
                            ENDWITH
                            lnCol = lnCol + 1
                        ENDIF
                        IF lnCol > 2 * lnMaxCols
                            lnRow = lnRow + 1
                            lnCol = 2
                        ENDIF 
                    ENDIF
                ENDDO
            NEXT
        ENDSCAN
        .ActiveWorkbook.SaveAs(lcFileName)
        .Quit
    ENDWITH
    RELEASE loExcel
    WAIT "工资条已生成" WINDOW
   
ENDPROC 

FUNCTION Get_Unit(tcString)
    LOCAL lnPos, lcUnit
   
    lcUnit = ""
    IF !EMPTY(tcString)
        lnPos = AT(",", tcString)
        IF lnPos > 0
            lcUnit = ALLTRIM(LEFT(tcString, lnPos - 1))
            tcString = SUBSTR(tcString, lnPos + 1)
        ELSE
            lcUnit = ALLTRIM(tcString)
            tcString = ""
        ENDIF
    ENDIF
   
    RETURN lcUnit
   
ENDFUNC 

PROCEDURE Get_Expression(tcString, tcCaption, tcExpression, tlBold)
    LOCAL lnPos1, lnPos2
   
    tcCaption = ""
    tcExpression = ""
    tlBold = ("<B>" $ tcString)
   
    lnPos1 = AT("[", tcString)
    lnPos2 = AT("]", tcString)
    IF (lnPos1 > 0) .AND. (lnPos2 > 0)
        tcCaption = ALLTRIM(SUBSTR(tcString, lnPos1 + 1, lnPos2 - lnPos1 - 1))
    ENDIF
    lnPos1 = AT("{", tcString)
    lnPos2 = AT("}", tcString)
    IF (lnPos1 > 0) .AND. (lnPos2 > 0)
        tcExpression = ALLTRIM(SUBSTR(tcString, lnPos1 + 1, lnPos2 - lnPos1 - 1))
    ENDIF
   
ENDPROC

有一个小BUG，偶然会出现空行，是为零输出造成的，暂时没调试出来怎么改，先将就一下吧，实在要改再说。

[ 本帖最后由 TonyDeng 于 2013-8-25 20:57 编辑 ]

授人以渔，不授人以鱼。

第 64 楼

得分:0

现在你可以任意修改数据表的字段了，输出是用表达式求出的，即允许各种运算，表达式的语法遵循VFP的语法即可。

授人以渔，不授人以鱼。

第 65 楼

得分:0

谢谢TonyDeng版主，我再调一下，成功我就结贴。再次谢谢！

第 66 楼

得分:0

TonyDeng版主，帮我看看模板文件哪里不对，生成的工资清单还是有空的单元格。设成一行显示四个字段，当某个字段的数据为0时，不打印，后面的字段就往前排，始终保持一行四个字段，这样工资清单就整齐了。几个另起一行的字段[出勤天数]开始，[税金]开始，[高温费]开始，其他都是按次序排列打印。字段间的运算我可以在VFP程序中处理完成，就是打印格式不能处理的完美。

工资清单.rar (4.16 KB)

第 67 楼

得分:0

版主,我有个思路，但不会写这个代码，就是设4个变量，每次取四个字段的值（0值舍去），循环取的次数取决于工资单显示总字段数/4，每个人的显示总字段数可能不一样的，所以要一个个取，这样打印排列的清单可能就会整齐了，你觉得这样可行吗？

第 68 楼

得分:0

上面那个BUG修复了，用下面的代码：

程序代码：

CLEAR ALL
CLEAR
Main()
CLEAR ALL
RETURN 

PROCEDURE Main()
    LOCAL lcFileName, loExcel, lnRow, lnCol, lnIndex, lnRecIndex
    LOCAL lnFile, laString[1], lcBuffer
    LOCAL lnMaxRows, lnMaxCols
   
    lnMaxRows = 10
    lnMaxCols = 4
   
    lcFileName = "工资条.txt"
    IF !FILE(lcFileName)
        MESSAGEBOX("文件" + lcFileName + "不存在！", 16, "")
        RETURN
    ENDIF
    lnFile = FOPEN(lcFileName)
    IF lnFile == -1
        MESSAGEBOX("文件" + lcFileName + "打开失败！", 16, "")
        RETURN
    ENDIF
    lnIndex = 0
    DO WHILE !FEOF(lnFile)
        lnIndex = lnIndex + 1
        DIMENSION laString[lnIndex]
        laString[lnIndex] = ALLTRIM(FGETS(lnFile))
    ENDDO
    FCLOSE(lnFile)

    IF !USED("工资")
        USE test_prn ALIAS 工资 IN 0
    ENDIF
   
    lcFileName = Application.DefaultFilePath + "\工资条"
    IF FILE(lcFileName + ".xls")
        loFileName = lcFileName + ".xls"
        DELETE FILE (lcFileName)
    ELSE
        IF FILE(lcFileName + ".xlsx")
            lcFileName = lcFileName + ".xlsx"
            DELETE FILE (lcFileName)
        ENDIF
    ENDIF
   
    WAIT "正在启动 Microsoft Excel Application，请稍候……" WINDOW NOWAIT
    loExcel = CREATEOBJECT("Excel.Application")
    WAIT "正在生成工资条，请稍候……" WINDOW NOWAIT
    WITH loExcel
        .SheetsInNewWorkbook = 1
        .Workbooks.Add
        .WorkSheets(1).Activate
        lnRecIndex = 0
        SELECT 工资
        SCAN ALL
            lnRecIndex = lnRecIndex + 1
            lnRow = 1 + (lnRecIndex - 1) * lnMaxRows
            IF lnRecIndex > 1
                .ActiveSheet.Rows(1 + (lnRecIndex - 1) * lnMaxRows).PageBreak = 1
            ENDIF
            FOR lnIndex = 1 TO ALEN(laString, 1)
                lnCol = 2
                lcBuffer = laString[lnIndex]
                DO WHILE !EMPTY(lcBuffer)
                    LOCAL lcCaption, lcExpression, llBold
                    Get_Expression(Get_Unit(@lcBuffer), @lcCaption, @lcExpression, @llBold)
                    IF lnCol > (2 * lnMaxCols)
                        lnRow = lnRow + 1
                        lnCol = 2
                    ENDIF 
                    IF EMPTY(lcCaption) .AND. EMPTY(lcExpression)
                        lnCol = lnCol + 1
                    ENDIF
                    IF !EMPTY(lcExpression) .AND. !Empty(EVALUATE(lcExpression))
                        IF !EMPTY(lcCaption)
                            WITH .Cells(lnRow + lnIndex, lnCol)
                                .Value = lcCaption
                                IF llBold
                                    .Font.Bold = .T.
                                ENDIF
                                .HorizontalAlignment = 3
                            ENDWITH
                            WITH .Cells(lnRow + lnIndex, lnCol + 1)
                                .Value = TRANSFORM(EVALUATE(lcExpression))
                                IF llBold
                                    .Font.Bold = .T.
                                ENDIF
                                .HorizontalAlignment = 3
                            ENDWITH
                            lnCol = lnCol + 2
                        ELSE
                            WITH .Cells(lnRow + lnIndex, lnCol)
                                .Value = TRANSFORM(EVALUATE(lcExpression))
                                IF llBold
                                    .Font.Bold = .T.
                                ENDIF
                                .HorizontalAlignment = 3
                            ENDWITH
                            lnCol = lnCol + 1
                        ENDIF
                    ENDIF
                ENDDO
            NEXT
        ENDSCAN
        .ActiveWorkbook.SaveAs(lcFileName)
        .Quit
    ENDWITH
    RELEASE loExcel
    WAIT "工资条已生成" WINDOW
   
ENDPROC 

FUNCTION Get_Unit(tcString)
    LOCAL lnPos, lcUnit
   
    lcUnit = ""
    IF !EMPTY(tcString)
        lnPos = AT(",", tcString)
        IF lnPos > 0
            lcUnit = ALLTRIM(LEFT(tcString, lnPos - 1))
            tcString = SUBSTR(tcString, lnPos + 1)
        ELSE
            lcUnit = ALLTRIM(tcString)
            tcString = ""
        ENDIF
    ENDIF
   
    RETURN lcUnit
   
ENDFUNC 

PROCEDURE Get_Expression(tcString, tcCaption, tcExpression, tlBold)
    LOCAL lnPos1, lnPos2
   
    tcCaption = ""
    tcExpression = ""
    tlBold = ("<B>" $ tcString)
   
    lnPos1 = AT("[", tcString)
    lnPos2 = AT("]", tcString)
    IF (lnPos1 > 0) .AND. (lnPos2 > 0)
        tcCaption = ALLTRIM(SUBSTR(tcString, lnPos1 + 1, lnPos2 - lnPos1 - 1))
    ENDIF
    lnPos1 = AT("{", tcString)
    lnPos2 = AT("}", tcString)
    IF (lnPos1 > 0) .AND. (lnPos2 > 0)
        tcExpression = ALLTRIM(SUBSTR(tcString, lnPos1 + 1, lnPos2 - lnPos1 - 1))
    ENDIF
   
ENDPROC

工资条.txt.zip (386 Bytes)

非压缩文件，删掉文件名后缀.zip

[ 本帖最后由 TonyDeng 于 2013-8-26 13:09 编辑 ]

授人以渔，不授人以鱼。

第 69 楼

得分:0

老师，我用您写的程序生成了工资条，见附件，还有一点点问题，还有空行，能不能一行四个字段排列，当有值等于0的字段时，后面的字段就填补在这个位置。你帮我看看这个模板文件，问题在哪里？怎么生成的工资条不与你的一样。不好意思，给您添了很多麻烦。谢谢您了！

求解答.rar (5.22 KB)

第 70 楼

得分:0

lnRow = 1 + (lnRecIndex - 1) * lnMaxRows 这一句是什么意思？“*”代表什么？