| |
こんにちは。かみちゃん です。
>セルにsheet名が入力されると、そのsheetが印刷されるマクロを作りたい
次のような感じになるかと思います。
あらかじめ、A1〜A3など、印刷したいシートが入力されているセルを選択した状態でMacro1を実行してください。
Option Explicit
Sub Macro1()
Dim c As Range
Dim StartSheetName As String
StartSheetName = ActiveSheet.Name
'選択している範囲を印刷対象シートが入力しされているセルとする。
For Each c In Selection
'シートが存在するかどうかをチェックする。
If chkSHEET(c.Value) Then
Sheets(c.Value).Select
'シートが存在したら印刷する
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Else
MsgBox c.Address & "に入力してある" & c.Value & "というシートは存在しません。"
End If
Next
Sheets(StartSheetName).Select
Range("A1").Select
End Sub
'シート名存在チェック
'http://www.ken3.org/backno/backno_vba19.html#92
' シート名を受け取り､
' 判断結果をTrue , Falseで返す関数
'
'関数名: chkSHEET
'入力値: シート名文字列
'戻り値 ：シートの有無・結果
'処理概要: シート名をパラメーターで受け取り､
' アクティブなブック内に存在するかを確認し､
' 結果のTrue , Falseを戻り値で返す
Function chkSHEET(strSNAME As String) As Boolean
Dim MyObject As Object
'ブック内のシート名の比較を行う
For Each MyObject In ThisWorkbook.Sheets
'.Nameプロパティのシート名と受け取ったstrSNAMEを比べる
If MyObject.Name = strSNAME Then
chkSHEET = True '名前が一致したのでTrueをセット
Exit Function 'もうすること無いので関数を抜ける
End If
Next
'一つも一致しなかったので、Falseをセット
chkSHEET = False
End Function
なお、シート名が入力されているセルがA1〜A3など、あらかじめ決まっている場合は、
For Each c In Selection
という部分を
For Each c In Range("A1:A3")
と変更していただければ、いいです。
|
|
かみちゃん
- 04/11/1(月) 7:25 -
