このプログラムは、メニューの教科を入れて「教科設定」を押したときに動作するプログラムです。
しかし、このプログラムを最初に考えたときは、どうしても上手くいきませんでした。シート名を単純に１回だけ変更することはできたのですが、変更後、さらに変更するというのが想定されたため、それを何とかしようとしたのと、もし、空欄のままでこのボタンを押されたらエラーが出てしまう（エクセルは名前のないシートは認めてくれない）ので、それも何とかしなくてはなりませんでした。そこで、シートにいったんシート名を書き出し、それを参照してシート名をさらに変更するという手段に出ました。空欄は「未設定」シートというものを設定することで回避しました。
2002/11/25 七条さん（HP）よりメールにて効率のよいプログラムを伝授いただきました。とてもすっきりして見やすいプログラムでした。中でもCellsは行と列を数値でしか入力できないと思っていたのですが、"K"のように使えるというのはとっても勉強になりました！
教えていただいたプログラムをこのプログラムの下に追加記載しておきます。私が最初に作ったものと比較してみると、すっきりさがわかっていただけると思います。
「教科設定」ボタンのプログラム
Sub シートの名前の変更()
Dim myn1, myn2, myn3, myn4, myn5, myn6, myn7, myn8, myn9, myn10, myn11, myn12, myn13, myn14, myn15, myn16 As String
Dim i As Integer
Dim myMsg, myTitle As String
Dim myBtn As Integer
myMsg = "空欄の換わりに「未設定」シートを設定します。"
myTitle = "何か言葉か記号を入力してください。"
myn1 = Worksheets("メニュー").Range("K5").Value
myn2 = Worksheets("メニュー").Range("A2").Value
myn3 = Worksheets("メニュー").Range("K6").Value
myn4 = Worksheets("メニュー").Range("A3").Value
myn5 = Worksheets("メニュー").Range("K7").Value
myn6 = Worksheets("メニュー").Range("A4").Value
myn7 = Worksheets("メニュー").Range("K8").Value
myn8 = Worksheets("メニュー").Range("A5").Value
myn9 = Worksheets("メニュー").Range("K9").Value
myn10 = Worksheets("メニュー").Range("A6").Value
myn11 = Worksheets("メニュー").Range("K10").Value
myn12 = Worksheets("メニュー").Range("A7").Value
myn13 = Worksheets("メニュー").Range("K11").Value
myn14 = Worksheets("メニュー").Range("A8").Value
myn15 = Worksheets("メニュー").Range("K12").Value
myn16 = Worksheets("メニュー").Range("A9").Value
i = Worksheets("メニュー").Range("A1").Value
If myn1 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbExclamation, myTitle)
myn1 = "未設定1"
End If
If myn3 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbQuestion, myTitle)
myn3 = "未設定2"
End If
If myn5 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbQuestion, myTitle)
myn5 = "未設定3"
End If
If myn7 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbQuestion, myTitle)
myn7 = "未設定4"
End If
If myn9 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbQuestion, myTitle)
myn9 = "未設定5"
End If
If myn11 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbQuestion, myTitle)
myn11 = "未設定6"
End If
If myn13 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbQuestion, myTitle)
myn13 = "未設定7"
End If
If myn15 = "" Then
myBtn = MsgBox(myMsg, vbOKOnly + vbQuestion, myTitle)
myn15 = "未設定8"
End If
If i = 1 Then
Worksheets(myn2).Name = myn1
Worksheets(myn4).Name = myn3
Worksheets(myn6).Name = myn5
Worksheets(myn8).Name = myn7
Worksheets(myn10).Name = myn9
Worksheets(myn12).Name = myn11
Worksheets(myn14).Name = myn13
Worksheets(myn16).Name = myn15
Else
Worksheets(myn2).Name = myn1
Worksheets(myn4).Name = myn3
Worksheets(myn6).Name = myn5
Worksheets(myn8).Name = myn7
Worksheets(myn10).Name = myn9
Worksheets(myn12).Name = myn11
Worksheets(myn14).Name = myn13
Worksheets(myn16).Name = myn15
End If
myn2 = Worksheets(myn1).Name
myn4 = Worksheets(myn3).Name
myn6 = Worksheets(myn5).Name
myn8 = Worksheets(myn7).Name
myn10 = Worksheets(myn9).Name
myn12 = Worksheets(myn11).Name
myn14 = Worksheets(myn13).Name
myn16 = Worksheets(myn15).Name
Worksheets("メニュー").Range("A2").Value = myn2
Worksheets("メニュー").Range("A3").Value = myn4
Worksheets("メニュー").Range("A4").Value = myn6
Worksheets("メニュー").Range("A5").Value = myn8
Worksheets("メニュー").Range("A6").Value = myn10
Worksheets("メニュー").Range("A7").Value = myn12
Worksheets("メニュー").Range("A8").Value = myn14
Worksheets("メニュー").Range("A9").Value = myn16
i = i + 1
Worksheets("メニュー").Range("A1").Value = i
End Sub
ここから下は上と同じことができる、教えていただいたプログラム（一部変更しましたが）です。上と比較するとコードの短さがわかりますね。
Sub シートの名前の変更()
Dim j, myc As Integer
Dim myMsg, myTitle As String
Dim mySheetName As String
myMsg = "空欄の換わりに「未設定」シートを設定します。"
myTitle = "設定したい教科欄に空欄があります。"
myc = 0
For j = 1 To 8
'入力データの読み取り
mySheetName = Worksheets("メニュー").Cells(5 + j - 1, "K").Value
'空欄の場合の処理
If mySheetName = "" Then
If myc < 1 Then
MsgBox myMsg, vbOKOnly + vbExclamation, myTitle
End If
mySheetName = "未設定" & j
myc = myc + 1
End If
'名前の変更
Worksheets(j + 2).Name = mySheetName
Next
End Sub
「ABCだよん!」の次回バージョンより、採用させていただきます。感謝致します。ありがとうございました！
その他、印刷にかかわるプログラムはたくさん使われていますが、別にとりたてて苦労したプログラムではありませんので、ご紹介する価値があまりなさそうなので、いろいろ考えましたが、ABCだよんのVBAのページはここまでにしておきたいと思います。
もし、印刷の方も知りたいとおっしゃる方がいらっしゃれば、メールにてご要望ください。
また、このページで紹介しているコードにつきましては、細心の注意を払ってはいますが、運用上いかなる損害が起きても責任を負わないものとします。
商用利用もご遠慮ください。
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します。すべての内容は日本の著作権法及び国際条約によって保護を受けています。
Copyright 2001-2012 H'sFactory. All rights reserved. Never reproduce or republicate without written permission.
トップへ
ABCだよん!
開発顛末
『ABCだよん!』のダウンロード
「ABCだよん!」について
