EXCEL VBA 連続のバーコード印刷
- EXCEL2010にて同シートにて下記コードでバーコードを１シート４件 表示してプリントアウトの繰り返しを行おうと思いますが ステップイン[F8]で１行づつ送ると思うようにバーコードが 印字されますがボタンクリックの自動処理を行いますと バーコード対象の品番は処理どおり印字されますが バーコードは１枚目と同様の項目で印字されてしまいます。 調べる限りバーコードVisible = True,Falseで表示されるなどありましたので 組み込みましたが変わりませんでした。 どのように変更すればよいのかご教示の程よろしくお願いいたします。
- EXCEL2010で、同じシートに４つのバーコードを表示し、繰り返しプリントアウトする方法を探しています。ステップ実行ではバーコードが正しく印字されますが、ボタンクリックの自動処理では、バーコード対象の品番は正しく印字されますが、バーコード自体は最初のものと同じ品番で印字されてしまいます。Visible = True, Falseを試してみましたが、問題は解決しませんでした。どのように変更すればよいでしょうか。
- EXCEL2010でバーコードを表示してプリントアウトする際、同じシートに４つのバーコードを表示し繰り返し印刷する方法を探しています。ステップ実行では正しくバーコードが印字されますが、ボタンクリックでの自動処理では、バーコード対象の品番は正しく印字されますが、バーコード自体は最初のものと同じ品番で印字されてしまいます。Visible = True, Falseで表示・非表示を試しましたが解決しませんでした。どのように変更すればよいのでしょうか。
- ベストアンサー
EXCEL VBA 連続のバーコード印刷
EXCEL2010にて同シートにて下記コードでバーコードを１シート４件 表示してプリントアウトの繰り返しを行おうと思いますが ステップイン[F8]で１行づつ送ると思うようにバーコードが 印字されますがボタンクリックの自動処理を行いますと バーコード対象の品番は処理どおり印字されますが バーコードは１枚目と同様の項目で印字されてしまいます。 調べる限りバーコードVisible = True,Falseで表示されるなどありましたので 組み込みましたが変わりませんでした。 どのように変更すればよいのかご教示の程よろしくお願いいたします。 Private Sub CommandButton2_Click() Dim 最終行 As Long With ActiveSheet Call クリヤ処理 入力 = 21 最終行 = .Cells(Rows.Count, 34).End(xlUp).Row 次: For 入力 = 入力 To 最終行 If .Cells(7, 1).Value = "" Then '左上 .Cells(7, 1).Value = .Cells(入力, 34).Value 'バーコード用品番入力セル .Cells(3, 34).Value = Left(.Cells(入力, 34).Value, 6) & Mid(.Cells(入力, 34).Value, 8, 3) ActiveSheet.BarCodeCtrl5.LinkedCell = "AH" & 3 ActiveSheet.BarCodeCtrl5.Visible = True ElseIf .Cells(7, 17).Value = "" Then '右上 .Cells(7, 17).Value = .Cells(入力, 34).Value 'バーコード用品番入力セル .Cells(3, 35).Value = Left(.Cells(入力, 34).Value, 6) & Mid(.Cells(入力, 34).Value, 8, 3) .BarCodeCtrl2.LinkedCell = "AI" & 3 .BarCodeCtrl2.Visible = True ElseIf .Cells(44, 1).Value = "" Then '左下 .Cells(44, 1).Value = .Cells(入力, 34).Value 'バーコード用品番入力セル .Cells(5, 34).Value = Left(.Cells(入力, 34).Value, 6) & Mid(.Cells(入力, 34).Value, 8, 3) .BarCodeCtrl3.LinkedCell = "AH" & 5 .BarCodeCtrl3.Visible = True ElseIf .Cells(44, 17).Value = "" Then '右下 .Cells(44, 17).Value = .Cells(入力, 34).Value 'バーコード用品番入力セル .Cells(5, 35).Value = Left(.Cells(入力, 34).Value, 6) & Mid(.Cells(入力, 34).Value, 8, 3) .BarCodeCtrl4.LinkedCell = "AI" & 5 .BarCodeCtrl4.Visible = True 'プリントアウト ActiveWindow.SelectedSheets.PrintOut Copies:=1 .BarCodeCtrl5.Visible = False .BarCodeCtrl2.Visible = False .BarCodeCtrl3.Visible = False .BarCodeCtrl4.Visible = False Call クリヤ処理 入力 = 入力 + 1 GoTo 次 End If Next 入力 End With End Sub Private Sub クリヤ処理() With ActiveSheet '左上 .Cells(7, 1).Value = "" .Cells(3, 34).Value = "" 'バーコード品番 '右上 .Cells(7, 17).Value = "" .Cells(3, 35).Value = "" 'バーコード品番 '左下 .Cells(44, 1).Value = "" .Cells(5, 34).Value = "" 'バーコード品番 '右下 .Cells(44, 17).Value = "" .Cells(5, 35).Value = "" 'バーコード品番 End With End Sub
- 77TAKETAKA
- お礼率65% (155/235)
- Excel（エクセル）
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
希望通りの動きが出来なければ捨ててください。 シートレイアウトも仕様も解らないまま想像で書いたので、 Private Sub CommandButton2_Click() Dim 最終行 As Long, i As Long, buf As Variant With ActiveSheet Call クリヤ処理 最終行 = .Cells(Rows.Count, 34).End(xlUp).Row For i = 21 To 最終行 buf = Left(.Cells(i, 34).Value, 6) & Mid(.Cells(i, 34).Value, 8, 3) For Each c In Range("A7,Q7,A44,Q44") c.Value = .Cells(i, 34).Value buf = Left(.Cells(i, 34).Value, 6) & Mid(.Cells(i, 34).Value, 8, 3) バーコード用品番入力セル If c.Address(0, 0) = "A7" Then .Cells(3, 34).Value = buf .BarCodeCtrl5.LinkedCell = "AH3" .BarCodeCtrl5.Visible = True ElseIf c.Address(0, 0) = "Q7" Then .Cells(3, 35).Value = buf .BarCodeCtrl2.LinkedCell = "AI3" .BarCodeCtrl2.Visible = True ElseIf c.Address(0, 0) = "A44" Then .Cells(5, 34).Value = buf .BarCodeCtrl3.LinkedCell = "AH5" .BarCodeCtrl3.Visible = True ElseIf c.Address(0, 0) = "Q44" Then .Cells(5, 35).Value = buf .BarCodeCtrl4.LinkedCell = "AI5" .BarCodeCtrl4.Visible = True End If Next 'プリントアウト ActiveWindow.SelectedSheets.PrintOut Copies:=1 .BarCodeCtrl5.Visible = False .BarCodeCtrl2.Visible = False .BarCodeCtrl3.Visible = False .BarCodeCtrl4.Visible = False Call クリヤ処理 Next End With End Sub
関連するQ&A
- エクセルVBAでShapesまたはDrawingObjects
シート上のフォームなどを表示/非表示するためtest04を書きましたが、「実行時エラー438 オブジェクトはこのプロパティまたはメッソッドをサポートしていません」となります。 しかし、Test05のように同じことをForNextで回せばうまくいきます。 また、Test06のようにShapesをDrawingObjectsに書き換えただけでもうまくいきます。 では、Test04がエラーになるのはなぜでしょうか？ Sub test04() With ActiveSheet.Shapes If .Visible = False Then .Visible = True Else .Visible = False End If End With End Sub Sub test05() For Each sp In ActiveSheet.Shapes If sp.Visible = False Then sp.Visible = True Else sp.Visible = False End If Next End Sub Sub test06() With ActiveSheet.DrawingObjects If .Visible = False Then .Visible = True Else .Visible = False End If End With End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBAについて
早速ですがExcelVBAについて質問です。 年齢がN列にあるとき、M列に年代を入れたいと思います。（例：19才なら10代、30才なら30代） 以下のように作成しましたが、すべてに20と入ったり正常に動作しないときがあります。 Excelは2003で作成していますが、いずれ2007でも使いたいです。 もっと正確に実行できるコードを教えてください。 ワークシート関数での解決は望んでいません。データ数も多く他の作業もマクロで処理するのでマクロを希望しています。よろしくお願いします。 -------------------------- Sub ByAge() Range("N1").Value = "年代別" Dim i As Long, N As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 13).Value >= 60 And Cells(i, 13).Value < 70 Then Cells(i, 14).Value = 60 ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then Cells(i, 14).Value = 50 ElseIf Cells(i, 13).Value >= 50 And Cells(i, 13).Value < 60 Then Cells(i, 14).Value = 40 ElseIf Cells(i, 13).Value >= 30 And Cells(i, 13).Value < 40 Then Cells(i, 14).Value = 30 ElseIf Cells(i, 13).Value >= 20 And Cells(i, 13).Value < 30 Then Cells(i, 14).Value = 20 End If Next i MsgBox "完了！" End Sub --------------------------
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで無限ループ
教えてください。 以下の２つのエクセルマクロはまったく同じことをさせようとしているのですが、test02の方は.Offset(1).Activateが働かないのか、無限ループに陥ってしまいます。 単にActiveCell.という記述をWith～End Withでまとめただけなのになぜこうなるのでしょうか？ Sub test01() ActiveSheet.Cells(1, 1).Activate Do While ActiveCell.Value <> "" If Not IsNumeric(ActiveCell.Value) Then ActiveCell.Offset(0, 1).Value = "文字" ElseIf ActiveCell.Value > 0 Then ActiveCell.Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then ActiveCell.Offset(0, 1).Value = "負数" Else ActiveCell.Offset(0, 1).Value = "その他" End If ActiveCell.Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End Sub Sub test02() ActiveSheet.Cells(1, 1).Activate With ActiveCell Do While .Value <> "" If Not IsNumeric(.Value) Then .Offset(0, 1).Value = "文字" ElseIf .Value > 0 Then .Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then .Offset(0, 1).Value = "負数" Else .Offset(0, 1).Value = "その他" End If .Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End With End Sub
- ベストアンサー
- オフィス系ソフト
- 複数のセルのなかに該当があればオートシェイプを表示
http://okwave.jp/qa/q8365189.html 上記質問の続きです。 画像のようなチェック表をExcelで作っています。 右側欄外に表を作成し、 ◎を付ける番号、○をつける番号をそれぞれ入力し、 「入力内容を反映」ボタンをクリックすると、 オートシェイプで配置した◎や○が表示されるようにしたいです。 VBAを以下のように作成してみたのですが、 ◎はつくのですが、 ○をつけるVBAが動きません。 どのように修正するべきでしょうか？ ご教授ください！ Private Sub CommandButton1_Click() '○で囲むVBA Dim c For Each c In Range("U103:Y103") If InStr(c.Value, "1") > 0 Then ActiveSheet.Shapes("1を囲む○").Visible = True Else ActiveSheet.Shapes("1を囲む○").Visible = False End If If InStr(c.Value, "2") > 0 Then ActiveSheet.Shapes("2を囲む○").Visible = True Else ActiveSheet.Shapes("2を囲む○").Visible = False End If Next c ・ ・ ・ '最も重要なものを◎で囲むVBA If Range("T103").Value = "1" Then ActiveSheet.Shapes("1を囲む◎").Visible = True Else ActiveSheet.Shapes("1を囲む◎").Visible = False End If If Range("T103").Value = "2" Then ActiveSheet.Shapes("2を囲む◎").Visible = True Else ActiveSheet.Shapes("2を囲む◎").Visible = False End If ・ ・ ・ End Sub ちなみに「'○で囲むVBA」のコードだけを残して動作させてみると、 1や2が一番右のセル（Y103）に入力されると、1を囲む○、2を囲む○がそれぞれ表示されるのですが、 それ以外のセル（U103からX103）に1や2を入力しても○は表示されません。 全コードを入力して動作させると、 1や2を一番右のセル（Y103）に入力しても○はどこにも表示されません。 よろしくお願いいたします！
- ベストアンサー
- オフィス系ソフト
- エクセル2007のマクロについて
B9に品番を入力するとA9に画像が自動挿入される所まではなんとか出来たのですが、 同じくB10,B11,B12・・・と下の行にも同じように品番を入力すれば画像が自動挿入される様にするには,どうのようにすれば良いのでしょうか？宜しくお願い致します。 A B 9 画像 品番 10 画像 品番 11 画像 品番 12 画像 品番 ・ ・ ・ Private Sub Worksheet_Change(ByVal Target As Range) Const ImagePath = "C:\Users\f\Desktop\画像\" If Intersect(Target, Range("B9")) Is Nothing Then Exit Sub Application.EnableEvents = False Dim codRange As Range Set codeRange = Range("B9") Dim picRange As Range Set picRange = Range("A9") Dim objPic As Picture For Each objPic In ActiveSheet.Pictures If objPic.Left >= picRange.Left And objPic.Left <= picRange.Left + picRange.Width _ And objPic.Top >= picRange.Top And objPic.Top <= picRange.Top + picRange.Height Then objPic.Delete Exit For End If Next picPath = ImagePath & codeRange.Value & ".jpg" If Dir(picPath, vbNormal) = "" Then picRange.Cells(1, 1).Value = "画像がありません" Else picRange.Select Sheets(1).Pictures.Insert(picPath).Select '画像ファイルの挿入 With ActiveSheet.Pictures(ActiveSheet.Pictures.Count).ShapeRange .LockAspectRatio = msoFalse .Parent.Visible = msoTrue .Left = picRange.Left .Top = picRange.Top .Height = picRange.Height .Width = picRange.Width End With picRange.Cells(1, 1).Value = "" End If Application.EnableEvents = True End Sub
- 締切済み
- オフィス系ソフト
- エクセルVBAを修正したい
数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 以下の記述が理解できません。 具体的にどのような処理をしているのか教えて下さい。 Do While Len(Range("C" & CStr(I)) & Range("D" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(12, J).Value & ActiveSheet.Cells(13, J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I, J).Value = "中止" Then ' ActiveSheet.Cells(I, J).Value = "中止" 'ActiveSheet.Cells(I, J + 1).Value = "" Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 9 tmp = "△" Case Is >= 10 tmp = "○" Case Is < 0 tmp = "**" End Select
- 締切済み
- Visual Basic
- エクセルVBAで xlOn xlOff の切替
エクセル2000です。 ワークシート上に配置したオブジェクトのVisibleのTrue Falseについては、test01の方法で切り替えることが出来ます。 では、Test02でIfで判定している、xlOn xlOff の切替についても同様にNOTを使って簡単に記述することはできないでしょうか？xlOn xlOff はTrue False ではないから無理なのでしょうか？ Sub test01() Dim o As Object For Each o In ActiveSheet.Buttons o.Visible = Not o.Visible Next o End Sub Sub test02() Dim o As Object For Each o In ActiveSheet.CheckBoxes If o.Value = xlOn Then o.Value = xlOff Else o.Value = xlOn End If Next o End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA
Excel VBAで アンケート集計をしたいと思い、プログラムを作ったのですが、J列までは入力がうまくいくのですが、K列にデータを入れて次の行にデータを入れると もともと存在していたＫれつのデータが消えてしまします。 どう修正すれば ちゃんとデータが残ってくれるのでしょうか？ 誰か教えてください Option Explicit Private Sub UserForm_Initialize() Dim チェックボックス As Control With cboBlood .AddItem "A型" .AddItem "B型" .AddItem "O型" .AddItem "AB型" End With cboBlood.ListIndex = -1 txtNo.Value = WorksheetFunction.Max( _ [Database].Resize(, 1)) + 1 txtNo.Enabled = False txtName.Text = "" optMale.Value = True txtAge.Value = 0 For Each チェックボックス In fraOS.Controls チェックボックス.Value = False Next txtName.SetFocus End Sub Private Sub cmdEntry_Click() Dim 行 As Long Dim 確認 As Integer 確認 = MsgBox("データを登録します。" _ & "よろしいですか?", vbYesNo) If 確認 <> vbYes Then Exit Sub 行 = [Database].Rows.Count + 1 [Database].Cells(行 - 1, 1).EntireRow.Insert [Database].Offset(行 - 1).Resize(1).Copy _ [Database].Cells(行 - 1, 1) [Database].Offset(行 - 1).Resize(1).ClearContents [Database].Cells(行, 1) = txtNo.Value [Database].Cells(行, 2) = txtName.Text If optMale.Value = True Then [Database].Cells(行, 3) = "男性" Else [Database].Cells(行, 3) = "女性" End If [Database].Cells(行, 4) = cboBlood.Text [Database].Cells(行, 5) = txtAge.Value If chkWin.Value = True Then _ [Database].Cells(行, 6) = "○" If chkMac.Value = True Then _ [Database].Cells(行, 7) = "○" If chkLinux.Value = True Then _ [Database].Cells(行, 8) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 9) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 10) = "○" Unload frmNew End Sub Private Sub cmdCancel_Click() Unload frmNew End Sub
- ベストアンサー
- その他(データベース)
- EXCEL VBA
Excel VBAで アンケート集計をしたいと思い、プログラムを作ったのですが、J列までは入力がうまくいくのですが、K列にデータを入れて次の行にデータを入れると もともと存在していたＫれつのデータが消えてしまします。 どう修正すれば ちゃんとデータが残ってくれるのでしょうか？ 誰か教えてください Option Explicit Private Sub UserForm_Initialize() Dim チェックボックス As Control With cboBlood .AddItem "A型" .AddItem "B型" .AddItem "O型" .AddItem "AB型" End With cboBlood.ListIndex = -1 txtNo.Value = WorksheetFunction.Max( _ [Database].Resize(, 1)) + 1 txtNo.Enabled = False txtName.Text = "" optMale.Value = True txtAge.Value = 0 For Each チェックボックス In fraOS.Controls チェックボックス.Value = False Next txtName.SetFocus End Sub Private Sub cmdEntry_Click() Dim 行 As Long Dim 確認 As Integer 確認 = MsgBox("データを登録します。" _ & "よろしいですか?", vbYesNo) If 確認 <> vbYes Then Exit Sub 行 = [Database].Rows.Count + 1 [Database].Cells(行 - 1, 1).EntireRow.Insert [Database].Offset(行 - 1).Resize(1).Copy _ [Database].Cells(行 - 1, 1) [Database].Offset(行 - 1).Resize(1).ClearContents [Database].Cells(行, 1) = txtNo.Value [Database].Cells(行, 2) = txtName.Text If optMale.Value = True Then [Database].Cells(行, 3) = "男性" Else [Database].Cells(行, 3) = "女性" End If [Database].Cells(行, 4) = cboBlood.Text [Database].Cells(行, 5) = txtAge.Value If chkWin.Value = True Then _ [Database].Cells(行, 6) = "○" If chkMac.Value = True Then _ [Database].Cells(行, 7) = "○" If chkLinux.Value = True Then _ [Database].Cells(行, 8) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 9) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 10) = "○" Unload frmNew End Sub Private Sub cmdCancel_Click() Unload frmNew End Sub
- ベストアンサー
- その他(データベース)
- 連続データのVBAの質問
お世話になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End If End Sub これはセルC１に年月を表記させ、そのC1セルの年月を変更した場合B９～B３９のセルが自動で連続データの数字を記入し、B9～B39のどこかのセルを空白にすると、そのセル以降も空白になります。 そしてR8～R38は、指定範囲のセルに数字を入力したら、そのセル以降の指定した範囲のセルに同じ数字を自動入力するVBAです。 そこで質問ですが、質問した現在は２０１３年１２月ですが、日本時間の現在の年月以前の年月（今で言うと２０１３年１１月以前）をC1に記入した場合はB9～B39の連続データの数字が切り替わらない様にするには、どうすれば宜しいでしょうか？
- ベストアンサー
- Excel（エクセル）
お礼
すみません。 同様にうまく動きませんでした。 プレビューではバーコード変わっているのに 連続動作の印刷すると１ページ目と 同様のバーコードが印刷されます。 プリンター印字処理で何か？かもしれません。 ありがとうございました。