【初月無料キャンペーン中】gooドクター

こんにちは、エクセル初心者です。
下記のようにネットから一括印刷のマクロをコピペしました。
シート名を数字に変更して活用したいのですが、シート名を数字に変更したら上手くいきません。
マクロの変更が必要なのswしょうか?
どう変更したら良いのでしょうか?

一括印刷シート
  シート名 対象印刷
3952 ⇐     ON⇐チェックボタン
試し     OFF
練習     OFF
模擬     OFF

下記よりマクロ記述
Sub 複数シートの一括印刷()

Dim rc As VbMsgBoxResult
Dim hairetu()
Dim shsu As Long
Dim ws As Worksheet
Dim i As Long
Dim x As Long
Dim y As Long
Dim wsmei As String

rc = MsgBox("「ON」になっているシートを一括で印刷します。よろしいですか?", vbYesNo + vbQuestion, "一括印刷実行の確認")
If rc = vbNo Then
Exit Sub
End If

shsu = Sheets.Count - 1
ReDim hairetu(1 To shsu)

For i = 1 To shsu
hairetu(i) = Sheets(i).Name
Next

i = 0
For i = 1 To shsu
y = 0
For x = 8 To 11 ' ← 状況によって変える所1
If ActiveSheet.Range("B" & x).Value = hairetu(i) Then ' ← 状況によって変える所2
y = y + 1
Exit For
End If
Next x
If y = 0 Then
MsgBox ("「一括印刷対象シート名」とシート名が異なるシートがあります。元に戻してください。")
Exit Sub
End If
y = 0
Next i

Erase hairetu

ReDim hairetu(1 To 4) ' ← 状況によって変える所3
i = 0
x = 0
For i = 1 To 4 ' ← 状況によって変える所4
If ActiveSheet.OLEObjects("sh" & i).Object.Caption = "ON" Then
hairetu(i) = 1
x = x + 1
Else
hairetu(i) = 0
End If
Next i

If x = 0 Then
MsgBox ("一括印刷の対象に指定がありません。")
Exit Sub
End If

i = 0
For i = 1 To 4 ' ← 状況によって変える所5
If hairetu(i) = 1 Then
Sheets(i).Activate
ActiveSheet.PrintOut
End If
Next i

Erase hairetu

End Sub

Private Sub sh1_Click() ' ← 状況によって変える所6

If sh1.Caption = "ON" Then
sh1.Caption = "OFF"
Else
sh1.Caption = "ON"
End If

End Sub

Private Sub sh2_Click() ' ← 状況によって変える所7

If sh2.Caption = "ON" Then
sh2.Caption = "OFF"
Else
sh2.Caption = "ON"
End If

End Sub

Private Sub sh3_Click() ' ← 状況によって変える所8

If sh3.Caption = "ON" Then
sh3.Caption = "OFF"
Else
sh3.Caption = "ON"
End If

End Sub

Private Sub sh4_Click() ' ← 状況によって変える所9

If sh4.Caption = "ON" Then
sh4.Caption = "OFF"
Else
sh4.Caption = "ON"
End If

End Sub
よろしくお願いいたします。

gooドクター

A 回答 (2件)

こんにちは


もう解決されていると思いますが、
どのように上手くいかないのか不明で、、、

#1様の回答のところだと思いますが、どうも数字でも文字列でも上手くいかないような感じがします

多分、Sheets(i).Activateの部分も変えているのではないかと思います。
Sheets(i) これは、シートインデックス
Sheets(1).Name は一番左にあるシート名です。
(Worksheetsでないのでグラフシートなどを含む)
1をシート名にするならSheets("1") となります。
シートインデックスとセル範囲インデックスが同じになっているのなら取敢えず動くのかもしれませんが、、、

数字は文字列の場合、全角と半角がある点も注意が必要ですね。
セルにあるのが数値 半角で シート名が全角だとエラー、逆もしかり。

コピペとの事なので関係ない事ですが、
If y = 0 Then は If y < 4 Then ではないかと思います。
また、
配列を作るループ内容と使うループ内容が同様なので配列を作る意味合いが無いように思います。

ご質問と関係ない部分なので興味が無ければ読み飛ばしてください。

sh1をクリックしてONなのに後からシートが無いと表示され書き換えを要求されるのは、どこが違うのかもわかりにくいですし、少し優しくないような気がします。
なので、Private Sub sh1_Click()時に シート名があるか判別した方が良いのではないでしょうか(無ければONにしない)

OLEObjectがどこに配置されているか分からないのですが、
例に挙げるコードは、原則としてOLEObjectの設置されている左隣のセルにシート名がある時の例です。 
(右隣にある場合はOffset(, -1)をOffset(, 1)とします。1つ下の場合はOffset(1)です。)

B8~B11にシート名
C列該当行 例えば、C8~C11に各sh1,sh2,sh3,sh4と設置されている場合
(オブジェクトの左上部分がC列該当セルに入っている状態)
sh1.TopLeftCell.Offset(, -1).Text でB8セルの内容が取得できます。

Private Sub sh1_Click() ' ← 状況によって変える所6
Dim SH As Object
With sh1
If .Caption = "ON" Then
.Caption = "OFF"
Else
For Each SH In Sheets
If SH.Name = .TopLeftCell.Offset(, -1).Text Then
.Caption = "ON"
Exit Sub
End If
Next
MsgBox ("指定のシート名は見つかりませんでした")
End If
End With

End Sub

こんな感じでシート名の有無を調べてON OFFを設定できます。
sh1・・・sh20 とかあったら大変なので 下記のようにまとめる事も出来ます。

Private Sub sh1_Click()
Call on_Check(sh1)
End Sub

Private Sub sh2_Click()
Call on_Check(sh2)
End Sub

Sub on_Check(objOLE As Object)
Dim SH As Object
With objOLE
If .Caption = "ON" Then
.Caption = "OFF"
Else
For Each SH In Sheets
If SH.Name = .TopLeftCell.Offset(, -1).Text Then
.Caption = "ON"
Exit Sub
End If
Next
MsgBox ("指定のシート名は見つかりませんでした")
End If
End With
End Sub

シート名チェックが出来ていれば
Sub 一括印刷()
Dim objOLE As Object
Dim mg As Variant
For Each objOLE In ActiveSheet.OLEObjects
If objOLE.Name Like "sh*" And objOLE.Object.Caption = "ON" Then
'Sheets(objOLE.TopLeftCell.Offset(, -1).Text).PrintOut
’取敢えずプレビュー
Sheets(objOLE.TopLeftCell.Offset(, -1).Text).PrintPreview
mg = mg & "シート:" & ActiveSheet.Name & vbCrLf
End If
Next
If mg = "" Then
MsgBox ("一括印刷の対象に指定がありません。")
Exit Sub
Else
MsgBox (mg & " 一括印刷しました。")
End If
End Sub
やはり、配列は出て来ませんでしたが、代わりにコレクション
ループの In の右側にある複数形の集合体を使いました。

補:オブジェクト名がsh+添え字となっていますが、このコードの場合
shtxt1のようなshから始まるすべてのオブジェクトが対象になってしまいます。そのような名前を付けなければ良いのですが、ワイルドカードを使っているので、もう少しオブジェクト名にした方が良いかも知れません。

状況によって変えるが多かったので
長々、ご質問と関係ない事を書いてしまいました。。。すいません。
    • good
    • 0
この回答へのお礼

ありがとう

回答ありがとうございます。
まだ回答内容についてイケてませんが、頑張ってみます。

お礼日時:2021/06/09 16:54

文字列だけであれば問題ないのでしょうか?


幾つか気になる点はありますが、大きな原因はValiable変数を使用していることにありそうです。

>For x = 8 To 11 ' ← 状況によって変える所1
>Next x
内の
If ActiveSheet.Range("B" & x).Value = hairetu(i) Then
では数値と文字列の比較になる可能性が高いので
If ActiveSheet.Range("B" & x).Text = hairetu(i) Then
の方が良い。
その後、hairetuを印刷有無の情報を収納するための配列として使用していますが、あまりお勧めできません。

Dim hairetu()
とするのではなく、きちんと2つの配列変数を適切な方で定義した方が良いと思います。

Dim hairetu_1() As String 'シート名なので文字列型
Dim hairetu_2() As Boolean '論理型 または数値を入力したければ Long等
    • good
    • 0
この回答へのお礼

ありがとう

ありがとうございます。

お礼日時:2021/06/09 16:55

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング