如何收集从VBA中的for循环创建的所有打印预览？

分类：编程问答

如何解决如何收集从VBA中的for循环创建的所有打印预览？

我有一个列表框，我希望从该列表框中以单次打印预览为所有选定客户打印预览报告。 youtube上有一个与此-> https://youtu.be/962Hd4akras相关的视频，如果您在单独的工作表上有数据，则可以了解如何实现该视频。但就我而言，我正在使用for循环来获取选定客户的数据。我正在一张一张地收集数据，并将其放到一个表格中，在其中进行一些格式化。我的代码为每个选定的客户提供了单独的打印预览。但是我想要的是为所有客户获得组合的打印预览（多页打印预览）。 这是我的代码。 注意：我有固定的工作表以及打印区域。

Sub SlipMacro2()

'Getting customer code number

Dim i,c,d As Long,FarmerCode As Integer
Dim SlipArray() As Integer

With PaymentMaster.lstDatabase
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            ReDim Preserve SlipArray(c)
            SlipArray(c) = .List(i)
            c = c + 1
        End If
    Next i
End With

For d = 0 To c - 1

    FarmerCode = SlipArray(d)

'Copying information 

    Dim pd,ps As Worksheet
    
    Set pd = ThisWorkbook.Sheets("purchasedata")
    Set ps = ThisWorkbook.Sheets("paymentslip")
    
    ps.Range("B8:N23").ClearContents

    Dim a,lr,j,b As Integer

    With PaymentMaster
    
        a = CDate(.TextBox2.Value) - CDate(.TextBox1.Value)
        lr = pd.Range("B" & Rows.Count).End(xlUp).Row + 1
        ps.Range("I5") = CDate(.TextBox1.Value)
        ps.Range("L5") = CDate(.TextBox2.Value)
        ps.Range("C5") = FarmerCode
        
        For j = 0 To a
            For b = 2 To lr
                If CDate(.TextBox1.Value) + j = pd.Range("B" & b) And pd.Range("D" & b) = FarmerCode Then
                    ps.Range("B" & j + 8) = CDate(.TextBox1.Value) + j
                    If pd.Range("C" & b) = "Morning" Then
                        ps.Range("C" & j + 8) = pd.Range("E" & b)
                        ps.Range("D" & j + 8) = pd.Range("F" & b)
                        ps.Range("E" & j + 8) = pd.Range("G" & b)
                        ps.Range("F" & j + 8) = pd.Range("H" & b)
                        ps.Range("G" & j + 8) = pd.Range("I" & b)
                        ps.Range("H" & j + 8) = pd.Range("J" & b)
                    ElseIf pd.Range("C" & b) = "Evening" Then
                        ps.Range("I" & j + 8) = pd.Range("E" & b)
                        ps.Range("J" & j + 8) = pd.Range("F" & b)
                        ps.Range("K" & j + 8) = pd.Range("G" & b)
                        ps.Range("L" & j + 8) = pd.Range("H" & b)
                        ps.Range("M" & j + 8) = pd.Range("I" & b)
                        ps.Range("N" & j + 8) = pd.Range("J" & b)
                    End If
                End If
            Next b
        Next j
    
    End With
    
ThisWorkbook.Sheets("paymentslip").PrintPreview

Next d

End Sub

解决方法

无法存储打印预览的结果或将先前获得的多个打印预览合并到新的打印预览中。

认识到这一点，您可以在每一步使用Copy方法制作“ payslip”工作表的副本，并创建将所有副本合并在一起的打印预览。

为此，您可以将这些工作表的名称存储在array内，然后可以将具有这些工作表名称的数组传递给Sheets对象，以进行PrintPreview的操作一张以上。

请注意，这将生成许多工作表，因此我们需要确保代码在的开始时删除了那些较早的副本

在您的代码中，看起来像这样：

Sub SlipMacro2()

    'Getting customer code number

    Dim i,c,d As Long,FarmerCode As Integer
    Dim SlipArray() As Integer

    With PaymentMaster.lstDatabase
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ReDim Preserve SlipArray(c)
                SlipArray(c) = .list(i)
                c = c + 1
            End If
        Next i
    End With

    For d = 0 To c - 1

        FarmerCode = SlipArray(d)

        'Copying information

        Dim pd,ps As Worksheet
    
        Set pd = ThisWorkbook.Sheets("purchasedata")
        Set ps = ThisWorkbook.Sheets("paymentslip")
    
        ps.Range("B8:N23").ClearContents

        Dim a,lr,j,b As Integer

        With PaymentMaster
    
            a = CDate(.TextBox2.Value) - CDate(.TextBox1.Value)
            lr = pd.Range("B" & Rows.Count).End(xlUp).Row + 1
            ps.Range("I5") = CDate(.TextBox1.Value)
            ps.Range("L5") = CDate(.TextBox2.Value)
            ps.Range("C5") = FarmerCode
        
            ''''''''''''''''''''''''''''''''''''''
            ' Delete older copies
            ''''''''''''''''''''''''''''''''''''''
            Dim ws As Worksheet
            For Each ws In ThisWorkbook.Worksheets
                If ws.Name Like ps.Name & " (*)" Then
                    Application.DisplayAlerts = False
                    ws.Delete
                    Application.DisplayAlerts = True
                End If
            Next

            ''''''''''''''''''''''''''''''''''''''
            ' Create list of sheets for the Print Preview
            ''''''''''''''''''''''''''''''''''''''
            Dim SheetsList() As Variant
            ReDim SheetsList(0 To a)
        
            For j = 0 To a
                For b = 2 To lr
                    If CDate(.TextBox1.Value) + j = pd.Range("B" & b) And pd.Range("D" & b) = FarmerCode Then
                        ps.Range("B" & j + 8) = CDate(.TextBox1.Value) + j
                        If pd.Range("C" & b) = "Morning" Then
                            ps.Range("C" & j + 8) = pd.Range("E" & b)
                            ps.Range("D" & j + 8) = pd.Range("F" & b)
                            ps.Range("E" & j + 8) = pd.Range("G" & b)
                            ps.Range("F" & j + 8) = pd.Range("H" & b)
                            ps.Range("G" & j + 8) = pd.Range("I" & b)
                            ps.Range("H" & j + 8) = pd.Range("J" & b)
                        ElseIf pd.Range("C" & b) = "Evening" Then
                            ps.Range("I" & j + 8) = pd.Range("E" & b)
                            ps.Range("J" & j + 8) = pd.Range("F" & b)
                            ps.Range("K" & j + 8) = pd.Range("G" & b)
                            ps.Range("L" & j + 8) = pd.Range("H" & b)
                            ps.Range("M" & j + 8) = pd.Range("I" & b)
                            ps.Range("N" & j + 8) = pd.Range("J" & b)
                        End If
                    End If
                Next b

                ''''''''''''''''''''''''''''''''''''''
                ' Make a copy of the sheet at the end of the workbook
                ''''''''''''''''''''''''''''''''''''''
                SheetsList(j) = CopySheetAtTheEnd(ps).Name
            
            Next j
    
        End With

        ''''''''''''''''''''''''''''''''''''''
        ' Pass the array to the Sheets object to get more than one sheet
        ''''''''''''''''''''''''''''''''''''''        
        ThisWorkbook.Sheets(SheetsList()).PrintPreview

    Next d

End Sub

Aslo确保包括以下功能：

Function CopySheetAtTheEnd(ByRef ws As Worksheet) As Worksheet
'This function is robust to the presence of hidden sheets
'Based on this answer: https://stackoverflow.com/a/24041228/5958842

    Dim wb As Workbook
    Set wb = ws.Parent
    Dim IsLastSheetVisible As Boolean
    
    With wb
        IsLastSheetVisible = .Sheets(.Sheets.Count).Visible
        .Sheets(Sheets.Count).Visible = True
        .Sheets(ws.Name).Copy AFTER:=.Sheets(Sheets.Count)
        Set CopySheetAtTheEnd = .Sheets(Sheets.Count)
        If Not IsLastSheetVisible Then .Sheets(Sheets.Count - 1).Visible = False
    End With

End Function
,

对不起，所有的麻烦，我找到了以下解决方法

Sub SlipMacro2()

Dim i,FarmerCode As Integer
Dim SlipArray() As String

With PaymentMaster.lstDatabase
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            ReDim Preserve SlipArray(c)
            SlipArray(c) = .List(i)
            c = c + 1
        End If
    Next i
End With

For d = 0 To c - 1

    FarmerCode = SlipArray(d)

    Dim pd,ps As Worksheet
    
    Set pd = ThisWorkbook.Sheets("purchasedata")
    Set ps = ThisWorkbook.Sheets("paymentslip")
    
    ps.Range("B8:N23").ClearContents

    Dim a,b As Integer

    With PaymentMaster
    
        a = CDate(.TextBox2.Value) - CDate(.TextBox1.Value)
        lr = pd.Range("B" & Rows.Count).End(xlUp).Row + 1
        ps.Range("I5") = CDate(.TextBox1.Value)
        ps.Range("L5") = CDate(.TextBox2.Value)
        ps.Range("C5") = FarmerCode
        
        For j = 0 To a
            For b = 2 To lr
                If CDate(.TextBox1.Value) + j = pd.Range("B" & b) And pd.Range("D" & b) = FarmerCode Then
                    ps.Range("B" & j + 8) = CDate(.TextBox1.Value) + j
                    If pd.Range("C" & b) = "Morning" Then
                        ps.Range("C" & j + 8) = pd.Range("E" & b)
                        ps.Range("D" & j + 8) = pd.Range("F" & b)
                        ps.Range("E" & j + 8) = pd.Range("G" & b)
                        ps.Range("F" & j + 8) = pd.Range("H" & b)
                        ps.Range("G" & j + 8) = pd.Range("I" & b)
                        ps.Range("H" & j + 8) = pd.Range("J" & b)
                    ElseIf pd.Range("C" & b) = "Evening" Then
                        ps.Range("I" & j + 8) = pd.Range("E" & b)
                        ps.Range("J" & j + 8) = pd.Range("F" & b)
                        ps.Range("K" & j + 8) = pd.Range("G" & b)
                        ps.Range("L" & j + 8) = pd.Range("H" & b)
                        ps.Range("M" & j + 8) = pd.Range("I" & b)
                        ps.Range("N" & j + 8) = pd.Range("J" & b)
                    End If
                End If
            Next b
        Next j
    
    End With
    
ps.Copy after:=ps
ActiveSheet.Name = FarmerCode

Next d

ThisWorkbook.Sheets(SlipArray()).PrintPreview
Application.DisplayAlerts = False
ThisWorkbook.Sheets(SlipArray()).Delete
Application.DisplayAlerts = True

End Sub

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

导入项目后报错问题
依赖报错 idea导入项目后依赖报错，解决方案：https://blog.csdn.net/weixin_42420249/article/details/81191861 依赖版本报错：更换其他版本 无法下载依赖可参考：https://blog.csdn.net/weixin_42628809/a
idea不能识别yaml文件
使用mybatis plus常见错误
错误1：代码生成器依赖和mybatis依赖冲突 启动项目时报错如下 2021-12-03 13:33:33.927 ERROR 7228 [ main] o.s.b.d.LoggingFailureAnalysisReporter : *************************** APPL
gradle常见问题与错误
错误1：gradle项目控制台输出为乱码 # 解决方案：https://blog.csdn.net/weixin_43501566/article/details/112482302 # 在gradle-wrapper.properties 添加以下内容 org.gradle.jvmargs=-Df
Mybatis Plus传入参数0不起作用
错误还原：在查询的过程中，传入的workType为0时，该条件不起作用 <select id="xxx"> SELECT di.id, di.name, di.work_type, di.updated... <where> <if test=&qu
linux中make编译源码包失败
报错如下，gcc版本太低 ^ server.c:5346:31: 错误：‘struct redisServer’没有名为‘server_cpulist’的成员 redisSetCpuAffinity(server.server_cpulist); ^ server.c: 在函数‘hasActiveC
微服务启动错误：Command line is too long. Shorten command line for
解决方案1 1、改项目中.idea/workspace.xml配置文件，增加dynamic.classpath参数 2、搜索PropertiesComponent，添加如下 <property name="dynamic.classpath" value="tru
vue常见错误
删除根组件app.vue中的默认代码后报错：Module Error (from ./node_modules/eslint-loader/index.js): 解决方案：关闭ESlint代码检测，在项目根目录创建vue.config.js，在文件中添加 module.exports = { lin
spark常见错误
查看spark默认的python版本 [root@master day27]# pyspark /home/software/spark-2.3.4-bin-hadoop2.7/conf/spark-env.sh: line 2: /usr/local/hadoop/bin/hadoop: No s
matplotlib报错：AttributeError: module 'backend_interagg' has no attribute 'FigureCanvas'. Did you mean: 'FigureCanvasAgg'?
使用本地python环境可以成功执行 import pandas as pd import matplotlib.pyplot as plt # 设置字体 plt.rcParams['font.sans-serif'] = ['SimHei'] # 能正确显示负号 p
gitlab登录失败，报错：This challenge page was accidentally cached by an intermediary and is no longer available.
设置时间 控制面板
后端开发常见错误
错误1：Request method ‘DELETE‘ not supported 错误还原：controller层有一个接口，访问该接口时报错：Request method ‘DELETE‘ not supported 错误原因：没有接收到前端传入的参数，修改为如下 参考 错误2：cannot r
docker常见错误
错误1：启动docker镜像时报错：Error response from daemon: driver failed programming external connectivity on endpoint quirky_allen 解决方法：重启docker -> systemctl r
idea常见错误
错误1：private field ‘xxx‘ is never assigned 按Altʾnter快捷键，选择第2项 参考：https://blog.csdn.net/shi_hong_fei_hei/article/details/88814070 错误2：启动时报错，不能找到主启动类 #
pip安装依赖失败
报错如下，通过源不能下载，最后警告pip需升级版本 Requirement already satisfied: pip in c:\users\ychen\appdata\local\programs\python\python310\lib\site-packages (22.0.4) Coll
maven常见错误
错误1：maven打包报错 错误还原：使用maven打包项目时报错如下 [ERROR] Failed to execute goal org.apache.maven.plugins:maven-resources-plugin:3.2.0:resources (default-resources)
cloud项目中常见错误
错误1：服务调用时报错 服务消费者模块assess通过openFeign调用服务提供者模块hires 如下为服务提供者模块hires的控制层接口 @RestController @RequestMapping("/hires") public class FeignControl
springboot常见错误
错误1：运行项目后报如下错误 解决方案 报错2：Failed to execute goal org.apache.maven.plugins:maven-compiler-plugin:3.8.1:compile (default-compile) on project sb 解决方案：在pom.
springmvc拦截器中使用redisTemplate报空指针异常
参考 错误原因 过滤器或拦截器在生效时，redisTemplate还没有注入 解决方案：在注入容器时就生效 @Component //项目运行时就注入Spring容器 public class RedisBean { @Resource private RedisTemplate<String
vite报错：npm ERR! command C:WINDOWSsystem32cmd.exe /d /s /c C:UsersychenAppDataLocalTempnpx-dde1c848.cmd
使用vite构建项目报错 C:\Users\ychen\work>npm init @vitejs/app @vitejs/create-app is deprecated, use npm init vite instead C:\Users\ychen\AppData\Local\npm-
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot