VBAで指定範囲を印刷する方法について

お世話になっております。
VBAで指定範囲の印刷方法ついてご教示をお願い致します。
添付しました画像の表があります。
この表はEセルから右にも違うデータが入力されております。
この表の印刷範囲をB2から始まり右にE3の「ぶどう」まで。
下にB9の「みかん」までを印刷範囲にしたいのですがVBAのプログラムで構築可能でしょうか？
この表はセルが挿入されたりとずれが生じるので「ぶどう」と「みかん」の文字データまでを印刷指定範囲にすれば業務時間短縮に繋がるかと思い質問致しました。

どなたか分かる方よろしくお願い致します。

No.2 ベストアンサー 回答者： fujillin 回答日時： 2017/07/20 14:37

こんにちは

よくわかりませんが・・・、印刷する対象範囲を
・開始位置は固定でB2セル
・終了位置は「B列でみかんのある行」と「3行目でぶどうのある列」の交点まで
として、印刷したいということと解釈しました。

実行すると、上記の範囲で印刷する例です。

Sub Sample()
Dim c As Range, a As String
Dim rw As Long, col As Long

rw = 0
col = 0

Set c = Rows(3).Find("ぶどう", After:=Range("B3"), LookAt:=xlWhole)
If Not c Is Nothing Then col = c.Column
Set c = Columns(2).Find("みかん", After:=Range("B2"), LookAt:=xlWhole)
If Not c Is Nothing Then rw = c.Row

If rw > 0 And col > 0 Then
a = ActiveSheet.PageSetup.PrintArea
ActiveSheet.PageSetup.PrintArea = Range(Cells(2, 2), Cells(rw, col)).Address
ActiveSheet.PrintOut
ActiveSheet.PageSetup.PrintArea = a
Else
MsgBox "印刷対象範囲が不明です"
End If
End Sub

この回答へのお礼

fujillin様ありがとうございます。
ぶどうの入力データを右に移動した際にも
このプログラムの実行でちゃんと印刷範囲が指定出来ました。
ありがとうございます。

他の方の回答者様も失礼ながらこの場をお借りしお礼申し上げます。
勉強、並びに活用させていただきます。
ありがとうございました。

お礼日時：2017/07/21 01:17

No.4 回答者： NURU_osan 回答日時： 2017/07/20 19:46

№1で回答した者ですがお礼を受けて再回答します。

イマイチ何をしたいのかよくわかりませんが、B2を先頭にして"みかん"と入力されているセルと”ぶどう”と入力されているセルを最後尾行または最後尾列になるように範囲を検出して、その範囲を印刷範囲に設定するのであれば以下の通りで出来るはずです。
”ぶどう”や”みかん”以外の文字列を追加したければArray()の中に文字列を追加するだけで対応するはずです。

Sub サンプル
Dim mySheet As Worksheet
Dim TargetCell As Range
Dim myArray As Variant
Dim I As Long
Dim R As Long
Dim endR As Long
Dim MaxR As Long
Dim C As Integer
Dim endC As Integer
Dim MaxC As Integer
Set mySheet = Thisworkbook.Worksheets("ワークシートの名前")
myArray = Array("みかん", ”ぶどう")
R=2
C=2
endR = mySheet.Rows.Count
endC = mySheet.Columns.Count
For I = 0 To UBound(myArray)
For C = 2 To endC
If WorksheetFunction.CountIf(mySheet.Range(mySheet.Cells(2, C), mySheet.Cells(endR, endC)), myArray(I)) = 0 Then Exit For
If WorksheetFunction.CountIf(mySheet.Columns(C),myArray(I)) > 0 Then
For R = 1 To endR
Set TargetCell = mySheet.Range(mySheet.Cells(R, C), mySheet.Cells(endR, C).Find(What:=myArray(I), LookAt:=xlWhole)
If TargetCell Is Nothing Then Exit R
MaxR = WorksheetFunction.Max(MaxR, TargetCell.Row)
MaxC = WorksheetFunction.Max(MaxC, TargetCell.Column)
Next R
End If
Next C
Next I
mySheet.PageSetup.PrintArea = mySheet.Range("B2", mySheet.Cells(MaxR, MaxC)).Address
Set mySheet = Nothing
Set TagretCell = Nothing
Erase myArray
I = 0
R = 0
endR = 0
MaxR = 0
C = 0
endC = 0
MaxC = 0
End Sub

No.3 回答者： WindFaller 回答日時： 2017/07/20 16:16

人は簡単だと思うのでしょうけれども、ちょっと難しい内容ですね。

ふつうはデータの範囲を、End プロパティで取得するというのが常識的です。
しかし、これはそうではないからです。
または、ショートカットを作って範囲設定をさせるというのが順当だと思います。

「みかん」と「ぶどう」が、それぞれがどういう意味を持っているのか、回答者側には分かりませんので、質問だけでみると、それをVBAなどで指し示すことは不可能なのです。
そこで、私が昔やっていた方法を披露します。
(失敗する可能性がひとつあるのは、その登録してあったセルや行や列を削除してまった場合です。）

数式－－名前の定義
例えば、LeftEnd <-「みかん」 RightTop <-「ぶどう」
(シート対象　×ブック全体）

'//ThisWorkbook モジュール
Private Sub Workbook_BeforePrint(Cancel As Boolean)
　Dim i As Long, j As Long
　Dim adr As String
　If ActiveSheet.Name <> "Sheet1" Then Exit Sub　'設定シート要登録
　On Error Resume Next
　i = Range("leftend").Row
　j = Range("righttop").Column
　If i = 0 Or j = 0 Then Exit Sub
　On Error GoTo 0
　adr = Range(Cells(2, 2), Cells(i, j)).Address
　ActiveSheet.PageSetup.PrintArea = adr
End Sub

もちろん、個別のボタンに対して、印刷マクロにしても良いと思います。

No.1 回答者： NURU_osan 回答日時： 2017/07/20 07:14

Worksheets("ワークシートの名前").PageSetup.PrintArea = "b2:e9"

で、印刷範囲を設定できます。

Worksheets("ワークシートの名前").PageSetup.PrintArea = ""

で、印刷範囲の設定を解除できます。

この回答へのお礼

NURU_osan様回答ありがとうございます。
こちらのプログラムを実行した際はE9で問題なく設定出来ましたが
表にセルを挿入した際にE9がF9、また二つ三つセルを挿入しますとそれに合わせ右にずれます。
当然なのですが。
このずれに合わせた何か良い方法などありますでしょうか？

よろしくお願い致します。

お礼日時：2017/07/20 07:50