VBA

Question

上下文 :

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

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

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

它以"line by line"的方式读取excel table，每行= 1个标签打印，每一列都是不同的数据，可以在我们决定的地方整合。

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

问题:

实际上我的列表是在这种形式下的：

想法是用户可以选中复选框以选择标签中的数据，然后通过绿色按钮生成列表 "Create print sheet"

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

结果应如下所示：

我用 "for loops" 以这样的方式使用数组对其进行编码：

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 statement" 会阻止所有内容，因此，没有什么可打印的...

我已经开始以另一种方式编写代码，通过一些 "select case"，但我们可能会向该文件添加一些列，并且只有这 3 个数据（Content + Nb 在一起）我已经有8例... 我想你知道如果我们添加几列，这会进行多快。那是不可能的。

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

这里是select案例代码（没写完没用继续）：

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

希望我的要求能被理解，谢谢大家！

Answer 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:

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

VBA - Dynamic multi column list with checkboxes for printing labels (through a DYMO printer)

excel

list

checkbox

dymo