0

コンテキスト:

私は自動車メーカーの会社で働いており、ブランド DYMO のラベル プリンターで印刷されるリストを生成するための Excel テーブルを作成する必要があります。

これらのラベルには、QR コードに複数のデータがあります。

DYMO ソフトウェアは、Excel の表を読み取って、一連のラベルを印刷できます。

「行ごと」の方法で Excel テーブルを読み取ります。各行 = 1 つのラベルが印刷され、各列は、決定した場所に統合できる異なるデータです。

これがインターフェースです(そうです、私はフランス人です^^、): DYMOプリントメニュー

問題:

私は実際にこのフォームの下に私のリストを持っています: 元のデータ テーブル

アイデアは、ユーザーがチェックボックスをオンにしてラベルに含まれるデータを選択し、緑色のボタン「印刷シートの作成」からリストを生成できるということです

「印刷しますか?」と呼ばれるすべての列の一番上のチェックボックス ユーザーがディーラーのラベルを生成できるようにすること (例として) ですが、ディーラー情報 (またはコンテンツなど) はありません。

結果は次のようになります。 ここに画像の説明を入力

そのような方法で配列を使用して「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 

私のリクエストが理解できることを願って、事前にすべてに感謝します!

4

1 に答える 1