VBA - 带有用于打印标签的复选框的动态多列列表（通过 DYMO 打印机）答案

【问题标题】：VBA - Dynamic multi column list with checkboxes for printing labels (through a DYMO printer)VBA - 带有用于打印标签的复选框的动态多列列表（通过 DYMO 打印机）
【发布时间】：2020-04-03 13:44:57
【问题描述】：

上下文：

我在一家汽车制造公司工作，我需要创建一个 Excel 表格，以便生成一个列表，该列表将由 DYMO 品牌的标签打印机打印。

这些标签将在一个二维码中包含多个数据。

DYMO软件可以读取一个excel表格，然后打印一堆标签。

它以“逐行”的方式读取excel表格，每行=打印1个标签，每一列都是不同的数据，可以在我们决定的地方集成。

这是界面（是的，我是法国人^^，）：

问题：

实际上，我的清单是在这种形式下的：

这个想法是用户可以选中复选框以选择将在标签中的数据，然后通过绿色按钮“创建打印表”生成一个列表

每列顶部的复选框，称为“打印？”是允许用户为经销商生成标签（例如），但没有经销商信息（或内容或其他）

结果应如下所示：

我使用“for 循环”以类似的方式使用数组对其进行编码：

for each dealer
    if checkbox checked
        Write dealer in the 1st position of the dataarray

        for each content
            if checkbox checked
                write content in the 2nd position of the dataarray
                write Nb in 3rd position of the dataarray

                for each CarModel
                    if checkbox checked
                       write car model in the 4th position of the dataarray

                        For i = 1 To Content.Value
                            For Each data In datarray
                                print that in the required column in the print sheet
                            Next
                        Next
                    End If
                Next
            End If
        Next
    End If
Next

这给出了：

For Each Dealer In Worksheets(MenuSheet).Range(PartnerListPos & FirstLine + 1 & ":" & PartnerListPos & PartnerListEnd)    'for each dealer
    If Worksheets(MenuSheet).Range(Dealer.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
        'to encode the data, if requested
        Set EncodeDealer = Worksheets(MenuSheet).Range(EncodeInfoPos & FirstLine + 1 & ":" & EncodeInfoPos & EncodeInfoEnd).Find("Bugatti Dealers")
        If EncodeDealer.Offset(0, 1) = True Then
            FinalData(1) = EncodeDecode.Base64EncodeString(Dealer)
        Else
            FinalData(1) = Dealer
        End If


        For Each Content In Worksheets(MenuSheet).Range(ContentContentPos & FirstLine + 1 & ":" & ContentContentPos & ContentContentEnd)      'for each Content
            If Worksheets(MenuSheet).Range(Content.Address).Offset(0, 2).Value = True Then 'if the corresponding checkbox is checked
                'to encode the data, if requested
                Set EncodeContentContent = Worksheets(MenuSheet).Range(EncodeInfoPos & FirstLine + 1 & ":" & EncodeInfoPos & EncodeInfoEnd).Find("Contents Nb.")
                If EncodeDealer.Offset(0, 1) = True Then
                    FinalData(2) = EncodeDecode.Base64EncodeString(Worksheets(MenuSheet).Range(Content.Address).Offset(0, 1).Value)
                Else
                    FinalData(2) = Worksheets(MenuSheet).Range(Content.Address).Offset(0, 1).Value
                End If


                For Each CarModel In Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine + 1 & ":" & CarsModelsPos & CarsModelsEnd)      'for each car
                    If Worksheets(MenuSheet).Range(CarModel.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
                        'to encode the data, if requested
                        Set EncodeCar = Worksheets(MenuSheet).Range(EncodeInfoPos & FirstLine + 1 & ":" & EncodeInfoPos & EncodeInfoEnd).Find("Cars Models")
                        If EncodeCar.Offset(0, 1) = True Then
                            FinalData(3) = EncodeDecode.Base64EncodeString(CarModel)
                        Else
                            FinalData(3) = CarModel
                        End If

                        'writing down the data
                        For NbExec = 1 To Worksheets(MenuSheet).Range(NbLabelPos & Content.Row).Value
                            For Each data In FinalData

                                Worksheets(PrintSheet).Range(ColExit & LineExit + FirstLineData).Value = data
                                ColExit = Split(Cells(1, Range(ColExit & 1).Column + 1).Address, "$")(1)
                            Next
                            If ColExit = Split(Cells(1, 1 + UBound(FinalData)).Address, "$")(1) And NbExec < Worksheets(MenuSheet).Range(NbLabelPos & Content.Row).Value Then
                                ColExit = "A"
                                LineExit = LineExit + 1
                            End If
                        Next
                        LineExit = LineExit + 1
                        ColExit = "A"
                    End If
                Next
            End If
        Next
    End If
Next

最大的问题是，当有人想在没有经销商的情况下打印标签，而只打印内容时，第一个“if 语句”会阻止所有内容，因此，没有什么可以打印...

我已经开始用另一种方式编写代码，通过一些“选择案例”，但我们可能会在这个文件中添加一些列，并且只有这 3 个数据（内容 + Nb 在一起）我已经有 8 个案例... 我想你知道如果我们添加几列，这可以有多快。这是不可能的。

*我不知道有什么样的解决方案可以解决我的问题？我什至不知道在搜索引擎上写什么来尝试得到答案：/ *

这里是选择案例代码（未完成，继续无用）：

Select Case DealerChkBx 'Dealer
    Case Is = 0 'Dealer
        Select Case FTINbChkBx    'FTI
            Case Is = 0    'FTI
                Select Case CarsChkBx   'Cars
                    Case Is = 0   'Cars 0 0 0
                        pouet = MsgBox("At least one checkbox should be checked...", vbOKOnly, "Nothing...")
                    Case Is > 0   'Cars 0 0 1
                        For Each CarModel In Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine + 1 & ":" & CarsModelsPos & CarsModelsEnd)      'for each car
                            If Worksheets(MenuSheet).Range(CarModel.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
                                If EncodeCar.Offset(0, 1) = True Then
                                    OneMoreCar = OneMoreCar + 1
                                    ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To CarsChkBx)
                                    FinalData(4, OneMoreCar) = EncodeDecode.Base64EncodeString(CarModel)
                                Else
                                    OneMoreCar = OneMoreCar + 1
                                    ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To OneMoreCar)
                                    FinalData(4, OneMoreCar) = CarModel
                                End If
                            End If
                        Next
                    End Select

            Case Is > 0    'FTI
                Select Case CarsChkBx   'Cars
                    Case Is = 0   'Cars 0 1 0
                        For Each FTINb In Worksheets(MenuSheet).Range(FTINbPos & FirstLine + 1 & ":" & FTINbPos & FTIContentEnd)      'for each car
                            If Worksheets(MenuSheet).Range(FTINb.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
                        'If Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine).Value = True Then 'if it is to be printed
                                If EncodeCar.Offset(0, 1) = True Then
                                    OneMoreFTI = OneMoreFTI + 1
                                    ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To FTINbChkBx)
                                    FinalData(2, OneMoreFTI) = EncodeDecode.Base64EncodeString(FTINb.Offset(0, -1).Value)
                                    FinalData(3, OneMoreFTI) = EncodeDecode.Base64EncodeString(FTINb)
                                Else
                                    OneMoreFTI = OneMoreFTI + 1
                                    ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To FTINbChkBx)
                                    FinalData(2, OneMoreFTI) = FTINb.Offset(0, -1).Value
                                    FinalData(3, OneMoreFTI) = FTINb
                                End If
                            End If
                        Next
                    Case Is > 0   'Cars 0 1 1

                End Select

        End Select

    Case Is > 0 'Dealer
        Select Case FTINbChkBx    'FTI
            Case Is = 0    'FTI
                Select Case CarsChkBx   'Cars
                    Case Is = 0   'Cars 1 0 0
                        For Each Dealer In Worksheets(MenuSheet).Range(DealerPos & FirstLine + 1 & ":" & DealerPos & DealerEnd)      'for each car
                            If Worksheets(MenuSheet).Range(Dealer.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
                        'If Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine).Value = True Then 'if it is to be printed
                                If EncodeDealer.Offset(0, 1) = True Then
                                    OneMoreDealer = OneMoreDealer + 1
                                    ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To DealerChkBx)
                                    FinalData(1, OneMoreDealer) = EncodeDecode.Base64EncodeString(Dealer)
                                Else
                                    OneMoreDealer = OneMoreDealer + 1
                                    ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To DealerChkBx)
                                    FinalData(1, OneMoreDealer) = Dealer
                                End If
                            End If
                        Next
                    Case Is > 0   'Cars 1 0 1

                End Select
            Case Is > 0    'FTI
                Select Case CarsChkBx   'Cars
                    Case Is = 0   'Cars 1 1 0

                    Case Is > 0   'Cars 1 1 1

                End Select
        End Select
End Select

希望我的要求是可以理解的，在此先谢谢大家！

【问题讨论】：

是否有一种方法可以“如果变量为假则不启动循环，但在内容存在时执行”？我可以使用我编写的第一个代码，并声明“如果列中没有选中复选框，则不要启动循环，而是执行其中的内容一次”......一会儿......做吗？
在 VBA 中有 3 种类型的 Do 循环。 1）同时做 2）做直到 3）做。前两个需要某种必须满足的条件。第三个将无限循环，直到循环内的某些东西调用Exit Loop
@GlennG 我知道这些循环，但它们无法帮助我......如果第一个循环不会被执行（因为立即满足退出因素），其余的不会被执行...
您是否尝试过在单元格上使用For...Each 循环？循环遍历范围内的每个单元格并检查是否满足条件，如果满足则执行某些操作
@GlennG 这正是我所做的，如果第一个 IF 没有找到任何带有“true”的单元格，那么其余的都不会执行。顺便说一句，问题来自 IF 语句而不是“for”循环，我将编辑我的帖子...

标签： excel vba list checkbox dymo

【解决方案1】：

好的，我想我有一个解决方案，一个肮脏的解决方案，但是工作...... 我使用了“GoTo Label”函数和变量来计算以这种方式检查的复选框的数量：

if NbDealer = 0 then
    GoTo NoDealer
End if
for each dealer
    if checkbox checked
        Write dealer in the 1st position of the dataarray
NoDealer :
        if NbContent = 0 then
            GoTo NoContent
        End if
        for each Content
            if checkbox checked
                write content in the 2nd position of the dataarray
                write Nb in 3rd position of the dataarray
NoContent:
                if NbCars = 0 then
                    GoTo NoCars
                End if
                for each CarModel
                    if checkbox checked
                       write car model in the 4th position of the dataarray
NoCars:
                        For Each data In datarray
                            print that in the required column in the print sheet
                        Next

                    End If
                if NbCars = 0 then    'just to avoid passing on the "Next" of the non initialized For loop
                    GoTo EndCars
                End if
                Next
EndCars:
            End If
        if NbContent = 0 then
            GoTo EndContent
        End if
        Next
EndContent:
    End If
if NbDealer = 0 then
    GoTo EndDealer
End if
Next
EndDealers:

【讨论】：