[[20170302205205]] 『ページ毎に特定のセルの値を読み取って印刷するか』（Shizune） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ページ毎に特定のセルの値を読み取って印刷するか否かを決めたい』（Shizune）
現在の状況、印刷プレビューです。
１枚の用紙に２ページ分まとめて印刷するように設定しております。
これをこのように印刷したいです。
「【1】」の「部品番号・部品名称」に 値 or 文字 が入力されている？
[入力されている]
→そのページを印刷する。
[入力されていない]
→そのページは印刷しない。
ご教授いただければ幸いです。
よろしくお願い致します。
画像が上手く表示されない方用。
https://imgur.com/yXMaiwZ
https://imgur.com/00dScJZ
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
>Shizune さん
エクセルVBAで、判定を行って、改ページの位置を変更するだけです。
納品書No1〜No6、それぞれの「セルの列番号、行番号」の範囲を教えてください。
納品書No.1の【1】のところとの具体的なセル番号を教えてください。 同様に、納品書No.2〜6の【1】のところとの具体的なセル番号も！
納品書No1〜No6は、同一シートで、No.7以降はないですね？
シートは、何枚ありますか？1枚だけですか？
納品書No.1〜6が存在している、シート名を教えてください。
実際の名前でなく、適当な名前でいいです。
（マリオ） 2017/03/02(木) 21:58
＞マリオ さん
お返事ありがとうございます。
納品書は全て同じシートでNo.1〜No.30まであります。
シート名は 納品書 です。
（そのまんまですね…。）
▼納品書No1〜No6、それぞれの「セルの列番号、行番号」の範囲〜
▼納品書No.1〜6の【1】のところとの具体的なセル番号も！
こちらになります。
No.1の範囲 A1:I17、【1】の所 C9
No.2の範囲 A18:I34、【1】の所 C26
↓
No.30の範囲 A494：I510、【1】の所 C502
よろしくお願い致します（、、
画像が上手く表示されない時用。
http://imgur.com/v5Qe4Iv
（Shizune） 2017/03/02(木) 22:22
実際の納品書はこんな感じです。(会社名等は変えました。)
背景を黄色で塗り潰している部分がそのページを印刷するか否かの判定箇所です。
画像が上手く表示されない時用。
http://i.imgur.com/ybPnx76
（Shizune） 2017/03/02(木) 22:37
>Shizune さん
「納品書シート」のコード記述欄に、下記を記述してください。
納品書を打ち込み終わったら、保存した後に、
ショートカットキー【 Ctrl + Home 】を押してください。
A1セルに、カーソルが移動することで、プログラムが実行されます。
(または、A1セルをマウスで選択して、プログラムを実行してください。）
**********************************************************
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
PageSetup.PrintArea = "" '印刷範囲を初期化
ResetAllPageBreaks 'すべての改ページを解除
Dim i As Long, k As Long, c As Range
For i = 1 To 30
k = (i - 1) * 17 + 9
Set c = Range("C" & k)
If Len(Trim(c)) = 0 Then
Exit For
ElseIf Len(Trim(c)) <> 0 And i Mod 2 = 0 Then
HPageBreaks.Add Before:=Range("A" & 17 * i + 1) '改ページ(水平)
End If
Next i
i = i - 1
If i Mod 2 <> 0 Then '最後の「納品書No」が奇数なら
HPageBreaks.Add Before:=Range("A" & 17 * i + 1) '改ページ(水平)
End If
If i = 0 Then
PageSetup.PrintArea = "$A$1:$I$9" '印刷範囲指定
Else
PageSetup.PrintArea = "$A$1:$I$" & 17 * i '印刷範囲指定
End If
PrintPreview
Set c = Nothing
End Sub
（マリオ） 2017/03/03(金) 00:41
＞マリオさん
すみません、コードを実行しても何故か上手く動作しない…。
と思ったら判定箇所には、
=Sheet2!E10&CHAR(10)&
Sheet2!F10
という数式(他のシートから商品名等を持ってくる数式)を入力していました。
この場合はLen関数の代わりにどの関数を使えばよいのでしょうか。
それと、ずうずうしいですが後学のために
「Dim i As Long〜」から「 ElseIf Len(Trim(c)) <> 0 And〜」の注釈文も書いていただければ幸いです。
よろしくお願いいたします。
（Shizune） 2017/03/03(金) 08:54
度々すみません。
ボタンを押してマクロを実行する形にはできますか？
（Shizune） 2017/03/03(金) 09:03
10行目の If Len(Trim(c)) = 0 Then
を、 If Len(Trim(c)) = 1 Then に変えたら正常に動作しました。
（Shizune） 2017/03/03(金) 09:37
>Shizune さん
>後学のために注釈文も書いていただければ幸いです。 >ボタンを押してマクロを実行する形にはできますか？ 次の記事でアップします。
>コードを実行しても何故か上手く動作しない…。 >と思ったら判定箇所には、 >=Sheet2!E10&CHAR(10)& >Sheet2!F10 >という数式を入力していました。
〓〓〓変更前〓〓〓〓〓〓〓〓〓〓〓〓
Set c = Range("C" & k)
If Len(Trim(c)) = 0 Then
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
を
〓〓〓変更前〓〓〓〓〓〓〓〓〓〓〓〓
Set c = Range("C" & k)
c = Replace(c, Chr(10), "")'★「Chr(10)」を「""」に置き換える
If Len(Trim(c)) = 0 Then
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
に変更してください。、
c = Replace(c, Chr(10), "")
を追加しています。
ワークシート関数では、CHAR(10)ですが、VBAでは、chr(10)です。 また、文字の置き換えは、 ワークシート関数では、SUBSTITUTE()を使用しますが、 VBAでは、Replace()です。
（マリオ） 2017/03/03(金) 00:41 のコードを修正しました。
「納品書シート」のコード記述欄に、下記を記述してください。
変数cntを追加してみました。
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub '選択セルが、A1セルなら次行以降のコードを実行する
PageSetup.PrintArea = "" '印刷範囲を初期化
ResetAllPageBreaks 'すべての改ページを解除
Dim i As Long, k As Long, c As Range, cnt As Long
For i = 1 To 30
k = (i - 1) * 17 + 9
Set c = Range("C" & k)
c = Replace(c, Chr(10), "") '★「Chr(10)」を「""」に置き換える
If Len(Trim(c)) = 0 Then
Exit For
Else
cnt = cnt + 1 'カウントする
If cnt Mod 2 = 0 Then
HPageBreaks.Add before:=Range("A" & 17 * cnt + 1) '改ページ(水平)を設定
End If
End If
Next i
If cnt = 0 Then
ElseIf cnt Mod 2 <> 0 Then '最後の「納品書No」が奇数なら
HPageBreaks.Add before:=Range("A" & 17 * cnt + 1) '改ページ(水平)
End If
If cnt = 0 Then
PageSetup.PrintArea = "$A$1:$I$9" '印刷範囲指定
Else
PageSetup.PrintArea = "$A$1:$I$" & 17 * cnt '印刷範囲指定
End If
PrintPreview
Set c = Nothing
End Sub
（マリオ） 2017/03/03(金) 18:47
>Shizune さん
>後学のために注釈文も書いていただければ幸いです。 >ボタンを押してマクロを実行する形にはできますか？
次のコードをxlsmファイルのmoduleに記述してください。 ★(1)moduleの作成の仕方は、分かりますか？ ★(2)ActiveXではなく、フォームコントロールのボタンの作成の仕方は、分かりますか？ ★(3)フォームコントロールのボタン作成後のマクロ登録の仕方は、分かりますか？
上記(2),(3)の作業「ボタンを作成してマクロ登録」をコード化 したものを次の記事でアップします。
シートに記述したコードには、シートを表す「sh.」がありませんでした。
下記の【Sub 改ページと印刷範囲の設定()】プロシージャで、
「sh.」が、どのような箇所に付加されているか確認してください。
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 Option Explicit '1行目に記述 - 変数を宣言しなと、警告します。
'下記の【改ページと印刷範囲の設定()】のコードでは、 'Debug.Printさせている箇所が、7箇所あります。■印の箇所です。 'イミディエイトウィンドウで確認してください。 'その場合、納品書シートのC9,C26,C43を順次、空白にしてから、コードを実行してください。
'例えば、18行目に改ページ（水平）を設定すると、17行目と18行目の境がページの境目になります。 'Excel2013の場合、表示Tabのブックの表示の項目の「改ページプレビュー」を左クリックすると 'どのように改ページが設定されているのかを目で見て確認することができます。
'余談ですが、今回は、J列より右側に印刷する物がないので、改ページは、水平方向だけを設定しています。 'J列より右側に印刷する物がある場合（列方向で複数のページがある場合）は、 '垂直方向の改ページの設定も必要になります。 '改ページ（水平）は、HPageBreaks.Addですが、改ページ（垂直）は、VPageBreaks.Addです。
Sub 改ページと印刷範囲の設定()
'----- 変数を宣言する ------------------------------------------------
Dim sh As Worksheet, i As Long, k As Long, c As Range, cnt As Long
'----- 印刷範囲を初期化して、すべての改ページを解除する --------------
Set sh = ThisWorkbook.Sheets("納品書") '★シート名
sh.Activate 'シートをアクティブにする
sh.PageSetup.PrintArea = "" '印刷範囲を初期化
sh.ResetAllPageBreaks 'すべての改ページを解除
'----- 改ページ（水平）を設定する -----------------------------------
Debug.Print "■■■■■■■■■■■■■■■■■■■■■■■■■■"
For i = 1 To 30 '納品書No.1〜30を取り扱うのでi=1〜30
k = (i - 1) * 17 + 9 'i=1,2,3,…30のとき、k=9,26,43,…,502
Set c = sh.Range("C" & k)
Debug.Print "■" & c.Address(False, False)
c = Replace(c, Chr(10), "") '「Chr(10)」を「""」に置き換える
'右辺左辺ともに、「c.Value」を「c」と省略して記述
If Len(Trim(c)) = 0 Then 'Trim処理（前後のスペース削除）した後の文字数がゼロなら、
Exit For 'Forループを抜ける
Else 'ゼロでないなら
cnt = cnt + 1 'カウントする←cntに、「+1」する
If cnt Mod 2 = 0 Then 'カウント数が偶数なら
sh.HPageBreaks.Add before:=sh.Range("A" & 17 * cnt + 1) '改ページ(水平)を設定する
Debug.Print "■" & 17 * cnt + 1 & "行目に改ページ（水平）を設定しました"
End If
End If
Next i
If cnt = 0 Then
Debug.Print "■" & "改ページ（水平）は設定しませんでした"
ElseIf cnt Mod 2 <> 0 Then '最後の「納品書No」が奇数なら
sh.HPageBreaks.Add before:=sh.Range("A" & 17 * cnt + 1) '改ページ(水平)
Debug.Print "■" & 17 * cnt + 1 & "行目に改ページ（水平）を設定しました"
End If
'----- 印刷範囲を指定する ---------------------------------------------
If cnt = 0 Then
sh.PageSetup.PrintArea = "$A$1:$I$9" '印刷範囲指定
Debug.Print "■" & "印刷範囲を「A1:I9」に設定しました"
Else
sh.PageSetup.PrintArea = "$A$1:$I$" & 17 * cnt '印刷範囲指定
Debug.Print "■" & "印刷範囲を「A1:I" & 17 * cnt & "」に設定しました"
End If
'----- 印刷プレビューを実行する ----------------------------------------
sh.PrintPreview
'----- 後処理 ----------------------------------------------------------
Set sh = Nothing: Set c = Nothing
End Sub
（マリオ） 2017/03/03(金) 18:50
>Shizune さん
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
【Sub 改ページと印刷範囲の設定()】
(2017/03/03(金) 18:50 のモジュールに貼り付けたコード)
を使用する場合は、納品書シートに貼り付けたコードは削除してください。
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
moduleに次のコードを貼り付けてください。 （【改ページと印刷範囲の設定】プロシージャを貼り付けたモジュールとは、 別のモジュールの方がいいかもしれません。module1,module2と別々にした方がいいかも）
ボタンを作成する場所は、「J2:J4」にしていますが、
お好みで変更してください。 ★セル幅、セルの高さを変更すると、ボタンの形状も変わります。 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 'Option Explicit '別モジュールに貼り付けた場合は、先頭の「'」を消去
Sub ボタン作成()
Dim B As Object, btn1 As Button, sh As Worksheet
Dim l As Single, t As Single, w As Single, h As Single
Set sh = ThisWorkbook.Sheets("納品書") '★シート名
For Each B In sh.Buttons
B.Delete '★シートにある、ボタンを全削除する
Next B
With sh
l = .Range("J2").Left
t = .Range("J2").Top
w = .Range(.Cells(2, "J"), .Cells(4, "J")).Width
h = .Range(.Cells(2, "J"), .Cells(4, "J")).Height
Set btn1 = .Buttons.Add(l, t, w, h) 'ボタンを挿入
End With
With btn1
.OnAction = "改ページと印刷範囲の設定" '★プロシージャ名（ボタンを押すと実行される）
.Text = "印刷" '★ボタンに表示するテキスト
.Name = "Button_1" '「Alt+F10」で表示されるオブジェクト名
End With
Set sh = Nothing: Set btn1 = Nothing
End Sub
（マリオ） 2017/03/03(金) 18:53
念のため、画像が無くなってしまったときのために…
【質問内容】 納品書シートに、 同じ様式の納品書が、No.1〜No.30まで 下記の表の範囲で存在しています。 判定箇所が、空白なら、それ以降の納品書は印刷したくないの、 ですが、VBAでｺｰﾄﾞを書くならどのようなコードになりますか？
なお、
C9=Sheet2!E10&CHAR(10)&Sheet2!F10 と数式を入れており、 CHAR(10)文字【改行：LF(ラインフィールド)】 が入っています。他の判定箇所も同様。
|[A] |[B] |[C] |[D] |[E] |[F]
[1]|納品書 No.|開始列|最終列|開始行|最終行|判定箇所
[2]| 1|A |I | 1| 17|C9
[3]| 2|A |I | 18| 34|C26
[4]| 3|A |I | 35| 51|C43
[5]| 4|A |I | 52| 68|C60
[6]| 5|A |I | 69| 85|C77
[7]| 6|A |I | 86| 102|C94
[8]|… |… |… |… |… |…
[9]| 30|A |I | 494| 510|C502
（マリオ） 2017/03/03(金) 19:15
質問内容にありませんでしたので、余計なお世話ですが…。
思い付きで、納品書複製マクロを作ってみました！ （★納品書でなくてもいいです。他の書類で応用できます。）
■プログラムの概要 「様式1シート」をNページ分複製して「様式2シート」を作成する。
「様式1シート」に、 1ページ分のフォーマット（納品書No1と納品書No2）を作っておけば、 コードで設定された複製数（★Const N As Long = 15のところ）、 フォーマットを複製して、「様式2シート」を完成させます。 つまり、複製数を150に設定すれば、納品書1〜300が、すぐ作成できます。
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
ファイルを置いておきます。
様式1シートをNページ分複製して様式2シートを作成する_02.xlsm
http://d.kuku.lu/c9e426bb11〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
■手順
(1)xlsmファイルに、シート名「様式1」を作成
(2)「様式1」シートのセル範囲「A1:I34」に適当なフォーマットを作成
(3)必要があれば、
ページ設定（印刷の向き、★拡大率、用紙サイズ、余白など）を変更
(4)moduleに下記のコードを貼り付けて、実行
適当なフォーマットとは、文字列を入れたり、罫線を設定したり、 セルの色を塗りつぶしたりなどの設定をすることをいいます。 フォーマット作成のセル範囲「A1:I34」は、コードのはじめのところ で変更可能です。
取り扱っている納品書の様式なら、H2,H19に次の数式をいれてみてください。 H2="No." & INT(ROW()/17)+1 H19="No." & INT(ROW()/17)+1 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 Option Explicit
Const N As Long = 15 '★複製数
Const fs1 As String = "様式1" '★シート名（複製元） Const fs2 As String = "様式2" '★シート名（複製先）
Const col_1 As String = "A" '★複製元のセル範囲「A1:I34」(1ページ分) Const col_2 As String = "I" '★ Const r1 As Long = 1 '★ Const r2 As Long = 34 '★
Sub 様式1シートをNページ分複製して様式2シートを作成する()
Dim sh1 As Worksheet, sh2 As Worksheet, c1 As Long, c2 As Long
Dim i As Long, j As Long, k As Long, x1 As Long, x2 As Long, myRng As Range
Set sh1 = ThisWorkbook.Sheets(fs1)
Call 様式2シートの初期化(sh1, sh2)
Application.ScreenUpdating = False '描画停止
'--- 列のアルファベットを列番号に変換 -----------------------------------------
c1 = sh1.Range(col_1 & "1").Column: c2 = sh1.Range(col_2 & "1").Column
'--- 行高の設定、フォーマットをコピペ、改ページを追加 -------------------------
For i = 1 To N
Application.StatusBar = i & " ページ 作成中です..." 'ステータスバー表示
'--- x1,x2を設定
x1 = r1 + (r2 - r1 + 1) * (i - 1): x2 = r2 + (r2 - r1 + 1) * (i - 1)
'--- 1行ずつ行高を設定
For j = r1 To r2
k = j + (r2 - r1 + 1) * (i - 1)
sh2.Rows(k).RowHeight = sh1.Rows(j).RowHeight
Next j
'--- フォーマットの範囲をコピペ
sh1.Range(sh1.Cells(r1, c1), sh1.Cells(r2, c2)).Copy _
sh2.Range(sh2.Cells(x1, c1), sh2.Cells(x2, c2))
'--- 改ページを追加（水平方向）
sh2.HPageBreaks.Add Before:=sh2.Range("A" & x2 + 1)
Next i
'--- 1列ずつ列幅を設定 --------------------------------------------------------
For j = c1 To c2
sh2.Columns(j).ColumnWidth = sh1.Columns(j).ColumnWidth
Next j
'--- 印刷範囲を指定する -------------------------------------------------------
Set myRng = sh2.Range(sh2.Cells(r1, c1), sh2.Cells(x2, c2))
sh2.PageSetup.PrintArea = myRng.Address
'--- メッセージを表示する -----------------------------------------------------
Application.ScreenUpdating = True '描画停止を解除
Application.StatusBar = "作成終了!" 'ステータスバー表示
MsgBox "「" & sh1.Name & "」シートを「 " & N & " 」ページ分複製して、" & _
vbCrLf & "「" & sh2.Name & "」シートを作成しました", _
vbOKOnly, " 作成終了!"
Application.StatusBar = False ''ステータスバー表示を元に戻す
'--- 後処理 -------------------------------------------------------------------
Set sh1 = Nothing: Set sh2 = Nothing
End Sub
Private Sub 様式2シートの初期化(ByVal sh1 As Worksheet, ByRef sh2 As Worksheet)
Application.ScreenUpdating = False '描画停止
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name = fs2 Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
Exit For
End If
Next
sh1.Copy Before:=sh1
ActiveSheet.Name = fs2
Set sh2 = ThisWorkbook.Sheets(fs2)
'-------------------------------------------------
'sh2.Activate 'アクティブにする
sh2.Cells.Clear 'シートの「値と書式」を削除
sh2.ResetAllPageBreaks 'すべての改ページを解除
sh2.PageSetup.PrintArea = "" '印刷範囲を初期化
sh2.Cells.RowHeight = 30 '高さの設定
sh2.Cells.ColumnWidth = 4.38 '幅の設定
Dim B As Object
For Each B In sh2.Buttons
B.Delete 'シートにある、ボタンを全削除
Next B
'-------------------------------------------------
Application.ScreenUpdating = True '描画停止を解除
End Sub
Sub 様式2シート削除()
Dim sh As Worksheet
Dim msg As String, rc As Integer
Dim flag As Boolean
For Each sh In ThisWorkbook.Sheets
If sh.Name = fs2 Then
msg = fs2 & "シートを削除しますか？"
rc = MsgBox(msg, vbYesNo, " 確認")
If rc = vbNo Then Exit Sub
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
flag = True
Exit For
End If
Next
If flag = False Then
msg = "「" & fs2 & "」シートがありません"
MsgBox msg, vbOKOnly, " 確認"
End If
End Sub
（マリオ） 2017/03/04(土) 09:57
＞マリオさん
大変わかり易く丁寧な解説、ありがとうございます！
恥ずかしながら質問する前に、「よくわかる Microsoft Excel 2013 基礎」「よくわかる Microsoft Excel 2013 応用」という本を買ったのですが、この2冊を隅から隅まで読んでも問題が解決しなくて困っていたので大変助かりました。
これを機にVBAとマクロについての本も購入しようかと思います。
重ね重ねありがとうございました（、、
（Shizune） 2017/03/04(土) 15:48
何度か使っていたら分かったのですが、
http://i.imgur.com/ybPnx76
図のC9には本来、
=Sheet2!E10&CHAR(10)&
Sheet2!F10
というsheet2にある商品データを出力する数式が入っています。
（この場合は「バクテリア TYPE XZ8」です。）
しかし、最新のコードを実行する度に、
数式が「バクテリア TYPE XZ8」という文字列自体に書き換わってしまいました。
〓〓〓削除〓〓〓
c = Replace(c, Chr(10), "")'★「Chr(10)」を「""」に置き換える
http://pastebin.com/dwxMWZ7w
大して変更していませんが一応変更後のソースも貼っておきます。
（Shizune） 2017/03/06(月) 09:42
しかしアップロードしたソースですが、見事に文字化けして何も読めませんね…（’’；
（Shizune） 2017/03/06(月) 09:47
私もですが、外部ストレージに置かれたファイルは、万が一にもウィルス検出されては困るので、決して見ない人が多いです。文字化けを気にするならZIPファイルにでも圧縮すれば良いですが、それでもダウンロードはしませんね。
また、掲示板に書けないくらい膨大なシートやマクロならば、それは掲示板に質問する域を超えていると考えても良いと思います。 問題箇所だけ、再現できる短い例とコードで表現して質問するようにしてください。 まぁ、再現できるコードを書けるくらいなら、その課程で解決できてしまいそうですが。
あと、本で勉強すればマクロが自由に使えるようになる、とお考えでしたら、それは間違いです。本は、テーマとした内容をコーディングするまでの指導をしてくれますが、そこに書かれた事しか覚えられません。自由に使えるようになった気にさせる、という所までです。しかし、Excelマクロでできる事はもっと多いので、Webで検索して試行錯誤する、というのが大事だと思いますよ。
（???） 2017/03/06(月) 10:00
>Shizune さん
>数式が「バクテリア TYPE XZ8」という文字列自体に書き換わってしまいました。
すいません。コード、間違ってましたね。 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 c = Replace(c, Chr(10), "") 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 としてしまうと、シート上の数式が、文字列に置き換わってしまいますね。 あらら…。
なぜなら、Set c = sh.Range("C" & k)
と定義したのだから！
以下、対策を記述します。 ☆が付いている3箇所が追加箇所、または訂正箇所です。
Rangeで宣言したcは、そのまま使用しますが、 空白の判定は、Rangeで宣言したcを用いるのではなく、 Stringで宣言したx（新しい変数！）を用いるように変更しました。
'----- 変数を宣言する ------------------------------------------------
Dim sh As Worksheet, i As Long, k As Long, c As Range, cnt As Long
Dim x As String '☆
………略………
x = CStr(Replace(c, Chr(10), "")) '☆「Chr(10)」を「""」に置き換える、CStrで文字列型に型変換
'「c.Value」を「c」と省略して記述(右辺)
If Len(Trim(x)) = 0 Then '☆
（マリオ） 2017/03/06(月) 11:10
cはRange型で宣言しました。xは、文字列型で宣言しました。 x = Replace(c, Chr(10), "") では、右辺がRange型、左辺が文字列型です。 なので、右辺で文字列型に変換するCStr処理しています。
次のようになります。 x = CStr(Replace(c, Chr(10), ""))
型変換については、下記参照 http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_050_08.html
※CStr処理を記述しましたが、CStr処理を記述しなくても 今回のケースでは、VBAが自動で型変換してくれるようです。
別件の事案で、型変換が大事になることもあります！ CDate,CDbl,CInt,CLng,CStrは、よく使いますね…。
（マリオ） 2017/03/06(月) 11:33
索引から調べやすい、お薦めのサイト
よねさんのWordとExcelの小部屋 http://www.eurus.dti.ne.jp/yoneyama/ 自宅でプログラミング! http://www.239-programing.com/ Excelでお仕事 http://www.asahi-net.or.jp/~ef2o-inue/top01.html エクセルの神髄 http://excel-ubara.com/ （マリオ） 2017/03/06(月) 19:24
＞マリオさん
お薦めのサイトまで…ありがとうございます。
全てブックマークさせていただきました。
ここで質問する前に購入したという2冊の本から察したと思いますが
私はExcelを触り始めたばかりの初心者(10日目くらい)なので
注釈文付きのコードとお薦めサイトの紹介は感謝してもしきれない程です。
『ページ毎に特定のセルの値を読み取って印刷するか否かを決めたい』
タイトルで私がした質問も
『印刷するか否かを判別したい箇所に〜〜〜って数式を入力をすれば解決するよ！』
というようにもっと簡単に済む問題かと思っておりました（。。；
コードも最初見た時は何がなんだかサッパリわからず
＞Private Sub Worksheet_SelectionChange(ByVal Target As Range)
「プライベート？ByVal…？書いてくれたのはマリオさんなんだからByMarioじゃないの？」
恥ずかしながらこのレベルからの出発でしたので…。
VBAに関する知識は皆無でしたが、先程紹介していただいたサイトで学習しながら
いつかは教わる側から教える側になれたらな、と思います。
この度は懇切丁寧にありがとうございました！
（Shizune） 2017/03/07(火) 02:27
>Shizune さん
こんなん作れたら、業務の改善に役立ちそうなり…ムフフ みたいな感じで、新しいプログラムの構想を思いついてしまったら、 また、いらしてください(^^♪
ちなみに、 【Sub 様式1シートをNページ分複製して様式2シートを作成する()】 のプロシージャについてですが、 ★ページ設定（用紙サイズ、余白、拡大率とか）を同じにするために、 様式1シートをコピーしたものを様式2シートにしています。
By Mario
（マリオ） 2017/03/07(火) 13:27
＞タイトルで私がした質問も
＞『印刷するか否かを判別したい箇所に〜〜〜って数式を入力をすれば解決するよ！』
＞というようにもっと簡単に済む問題かと思っておりました（。。；
よく見てないですが。。。
印刷の様式を何枚も用意せずに、
８行ずつ転記して印刷すればいい話では？
つまり２０個データがあれば、
２０÷8≒3回 転記→印刷を繰り返せばいいと思います。
まぁ、印刷様式をたくさん用意して数式セットしてもいいですが、
印刷するデータ数を数えれば、何枚印刷すればいいか解るはず。ですよね？
さすがに数式で印刷する範囲をコントロールできないと思うけど、
もしかしたら出来るのかな？？？
（出来そうな気がしないでもけど、個人的にはマクロで処理しますかね。）
たくさん用意するなら縦にずらずら行った方がどうやるにしても便利でしょうね。
目視でみて、印刷する範囲を選択して、選択部分だけ印刷っていう方法もあると思います。
マクロを知らないし、マクロを覚える気もないなら、
マクロ使わない方が無難です。
マクロ覚えるのもかなり大変ですから。。。
メンテナンス出来ない人が、中途半端なマクロ貰っても、
もてあますだけかも。。。
ここで質問したら、
興味がある人がマクロ作ってくれるかも知れないですが、
ここはマクロを作ってもらう場所では無いでしょうから、
マクロ作ってくれる場所と認知されるのは、
サイト運営者の本望ではないでしょう。
（まっつわん） 2017/03/07(火) 13:57
＞???(すみません、名前が文字化けしてて読めません)さん、まっつわんさん
ご忠告感謝です。
本で勉強すればマクロが自由に使えるようになるとは微塵も思ってはいませんが、
勉強意欲はあるので教えていただいたサイトを見ながら学んでいくつもりです。
最初はPrintAreaの参照範囲に =INDIRECT(A1) を指定して A1 にIF文を書こうかと思ってました。
=IF(C9=判別条件,true1の印刷範囲,
IF(C26=判別条件,true2の印刷範囲,
IF(C43=判別条件,true3の印刷範囲,
IF(C60=...
ただ、私のやり方だとIF関数のネストが増えるに連れて分かり辛くなるので、
もっと簡単に出来る方法はないかと思い皆様のお力をお借りしました。
※今回はマリオさんに丸投げする形になってしまいましたが（、、
＞マリオさん
＞こんなん作れたら、業務の改善に役立ちそうなり…ムフフ
＞みたいな感じで、新しいプログラムの構想を思いついてしまったら、
＞また、いらしてください(^^♪
昨日教えていただいたサイトを見ながら手始めに今までに作った
「動作を記録させて作ったマクロ」の手直しを行っていますが、
無駄な処理を省けたり新たに機能を追加できたりと良い感じです。
まだまだVBAを触り始めて間もないですが楽しいですねこれ(｡･ω･｡)
長くなりましたが、今一度マリオさんに謝辞を述べて質問と書き込みを終えたいかと思います。
ありがとうございました！
（Shizune） 2017/03/07(火) 15:09
>Shizune さん
>「動作を記録させて作ったマクロ」の手直しを行っていますが、 >無駄な処理を省けたり新たに機能を追加できたりと良い感じです。 >まだまだVBAを触り始めて間もないですが楽しいですねこれ(｡･ω･｡)
ふふふ、はまりすぎちゃダメですよ(#^^#) まだ、掲示板見てますか？ >質問と書き込みを終えたいかと思います。 とありましたが…。勉強意欲があるとのことですので、もう1つだけ。
コーディング作業時などに、テキストエディタを使用するとなにかと便利です。 下記の(1)の2つのテキストエディタをお薦めします。 (2)以降は、私の場合の設定ですので、興味があったら、試してみてください。
************************************************************************************
(1)「TepaEditer (Version 5.0.5)」と「サクラエディタ(2.2.0.1)」をインストールして、
サクラエディタにtxtを関連付ける。
http://www.greenspace.info/tepa/
http://sakura-editor.sourceforge.net/download.html
************************************************************************************ (2)「C:\Free_Soft\memo\メモ帳.txt」に、「メモ帳.txt」を置いておく。
(3)テキストエディタ2つを簡単に起動できるように、かざぐるマウスを導入する。 http://forgetmenots.doorblog.jp/tag/%E3%81%8B%E3%81%96%E3%81%90%E3%82%8B%E3%83%9E%E3%82%A6%E3%82%B9 かざぐるマウス 1.66 正式版（64bitまたは32bit）をダウンロードしてzipを解凍してください。
私の場合、(C:\Program Files\かざぐるマウス)の「かざぐるマウス」フォルダ内にKazaguru.exeなどのファイルを入れてます。 「かざぐるマウス」フォルダ」は、手作業で作成！
使い方については、下記参照してください。スタートアップ起動するようにする。 http://forgetmenots.doorblog.jp/archives/34094626.html
(4)かざぐるマウス オプションの「マウスジェスチャーtab」にて、 割り当てるコマンドの右側のリストを「外部ツール」にして、 「外部ツール」の右側のリストから「外部ツールの編集」を選択して、 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 【名前：サクラエディタ、コマンド：C:\Free_Soft\memo\メモ帳.txt】 【名前：Tepa、コマンド：C:\Program Files (x86)\TepaEditor\tepa.exe】 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 を作成しておいて、下記の設定をした後、適用ボタンを押して、ＯＫﾎﾞﾀﾝを押す。 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 ジャスチャー「→←↓」において、カテゴリ「外部ツール」、コマンド「サクラエディタ」 ジャスチャー「→←↑」において、カテゴリ「外部ツール」、コマンド「Tepa」 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓 すると、マウスの右クリックボタンを押し続けている状態で、「T」の文字を一筆書き（緑の線が表示される！！）した後に、 マウスの右クリックボタンの押下げを解放すると、 ジャスチャー「→←↓」をしたことになり、【C:\Free_Soft\memo\メモ帳.txt】が開きます。 ジャスチャー「→←↑」も同様。こちらは、tepa.exeのアプリ起動です。 ちなみに、「T」は、「Text」の「T」です。
（マリオ） 2017/03/07(火) 18:02
「エクセルの学校」における新規登録やコメントで、 文章の先頭箇所に「 」（半角スペース1つ）が入っていると、文字が小さくなりますが、 「サクラエディタ」の「正規表現」を使用した置換作業をすると、 すべての文章の先頭箇所に「 」（半角スペース1つ）を入れることができます。
■サクラエディタの使い方の例（正規表現を使用して先頭に半角スペース1つを入れる） 〓〓〓〓〓〓 あいうえお かきくけこ
〓〓〓〓〓〓 と入力した後に、★「Ctrl+R」を押すと、置換ダイアログボックスが開く。
「正規表現」にチェックが入っていることを確認後、 置換前のテキストボックスをマウスで左クリックして、 ★「^」(Back Spaceボタンの左2個目にあるかな？)を入力。
Tabボタンを押すと、置換後のテキストボックスに移るので、 ★「 」（半角スペース1つ）を入力し、「すべて置換」ボタンを押す。
******************************************************************* ■サクラエディタの使い方の例（正規表現を使用して、文末の改行をすべてなくす） 同様にして、正規表現で★「\r\n」を★「」（入力なし）に置換
******************************************************************* ■TepaEditorの使い方の例（正規表現を使用して、文末の改行をすべてなくす） ヘルプtabの右下にある「検索・置換オプション」（小さな赤文字でOPと記述：双眼鏡の絵） を左クリックして、正規表現検索にチェックが入っていることを確認する。
次に、左側のテキストボックスに、★「\n」を入力後、右側のテキストボックスに、★「」（入力なし） として、右側のテキストボックスの３個右にある「全置換」（小さな赤文字でALLと記述）を押す。 （マリオ） 2017/03/07(火) 18:03
投稿
[[20170307120157]] 『印刷範囲設定について』（tomo）
について...
こっちと基本的に同じ質問と思いますが。。。
（まっつわん） 2017/03/07(火) 19:10
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.