コンテキスト:
私は自動車メーカーの会社で働いており、ブランド DYMO のラベル プリンターで印刷されるリストを生成するための Excel テーブルを作成する必要があります。
これらのラベルには、QR コードに複数のデータがあります。
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
私のリクエストが理解できることを願って、事前にすべてに感謝します!