シートの保護と写真の挿入・設置を上手く調整したい

質問

仕事でExcelを活用したいと思い、少し古いですが2000を使い始めました。
今作ろうとしているのは、３０商品ほどの情報管理が出来るブックです。

１つの原価表シートと、商品分の複数シートがあります。
原価表シートの情報を、VLOOKUP関数を用いて各商品のシートにコード入力で
名称や原価の反映が出来るようにしました。

関数の設定箇所が非常に多いので、このブックは各シートに保護が必要です。
（操作に不慣れな人や、ミスで関数が消えてしまう事の防止のため）

☆★☆上記を踏まえて、以下に質問があります☆★☆

コードの入力だけならば、シートを保護する際に所定のセルのロックを外して
保護をかければ問題はありません。

しかし、各シートには「商品写真」欄を必ず１つ用意しなくてはいけません。
写真は、都度商品が追加されるたびに、デジカメ等で撮影して取り込みます。

操作に不慣れな人を考慮すると、都度の保護と解除はミスの原因になりやすく
不安なため、シート内で上手く保護のかかった状態から画像の挿入と調整が
出来ないか悩んでおります。

どういった形でかは一時的に解除が必要かと思うのですが、マクロやＶＢＡ
まではまだ理解が出来ていなく、この辺り上手くできる方法などご教授を
頂けませんでしょうか？

説明に分かりにくい点がありましたら申し訳ありません。
よろしくお願いします。

回答No.3

KenKen_SP · ベストアンサー

こんばんは。KenKen_SP です。

【テスト用サンプルブックでのマクロ導入手順】

1.　新規ブックを作成し、適当なフォルダへ保存
2.　Excel 画面で[Alt]+[F11]キーを押し Visual Basic Edior（以下VBE）を起動
3.　VBE 画面左側のエクスプローラーのようなツリーで「ThisWorkbook」の
　　アイコンをダブルクリック
4.　3. で開いた画面に #2 の　Option Explicit ～ 終わりまでをコピペ
5.　VBE を閉じる
6.　再度ブックを保存
7.　ブックを閉じる
8.　ブックを再度開く

以上の手順で、セルの右クリックに「画像の挿入」メニューが追加されてます。
シートが保護されていても大丈夫(´・ω・`)

お礼

KenKen_SP様、導入の手順までご説明頂きありがとうございます。
シートが保護されている状態でも、画像の挿入と位置調整などが
可能であることを確認できました。
理想の通りに完成しまして、大変満足しております。
まだまだ関数で手一杯の状態ではございますが、今後も引き続き勉強を
していきたいと思います。
本当にありがとうございました。

回答No.2

KenKen_SP

こんばんは。KenKen_SP です。

シートを保護してしまうと画像の挿入ボタンがグレーアウトしますね...
VBA を使って構わないならこんな感じで実現できますよ。

・画像の挿入は、オリジナルのメニューがセルの右クリックに追加されて
　ますので、そこから。50％縮小や選択範囲のサイズにあわせる機能がオマケ
　で付いてます。複数枚同時挿入も可能です。
・管理者用に一括でシートを保護・保護解除できるようになってます。
　[ツール]-[マクロ]-[マクロ]から実行します。
　初期パスワード： admin
・一応マクロが無効で開かれた場合の対策をしてあります。
・VBA プロジェクトにパスワードを設定して下さい。（<--重要)
・テストで実用に耐えうるか必ず評価して下さい。いきなり実際のブックに
　組み込まないこと。

結構複雑な仕組みなので、マクロの知識がある人が周囲にいなければ、メンテ
で辛くなりますが、シンプルに作れそうもない内容でした...まあ、余計な機能
もあるわけですが(´・ω・`)

万全の保護は現実的に不可能なのですが、それなりに強固な保護になっていると
思いますよ。

' 注意： 全て ThisWorkbook です。貼り付ける場所等はご自分でお調べ下さい。

Option Explicit

' 設定 ------------------------------------------------------------------------
' シート保護のパスワードを設定（無しなら""とする)
Private Const PASSKEY = "123"
' 管理者パスワード（シートの一括保護・解除に使用します）
Private Const ADMIN_PASSKEY = "admin"
'------------------------------------------------------------------------------

' 以下のパスワードは変更不要
Private Const BOOK_PASSKEY = vbVerticalTab & "__BOOK_PASSKEY__" & vbVerticalTab
Private WithEvents mApp　As Application
Private mcMenu　　　　　 As CommandBarControl
Private mCloseFlag　　　 As Boolean

Private Sub Workbook_Open()
　　On Error Resume Next
　　With ThisWorkbook
　　　　.Unprotect Password:=BOOK_PASSKEY
　　　　.IsAddin = False
　　　　.Saved = True
　　End With
　　If mApp Is Nothing Then Set mApp = Application
　　' カスタムメニューをセルの右クリックに追加
　　Call AddCustomMenu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Dim iRes As Integer
　　On Error Resume Next
　　mcMenu.Delete
　　If Not ThisWorkbook.Saved Then
　　　　Cancel = True
　　　　iRes = MsgBox(ThisWorkbook.Name & "の変更を保存しますか?", _
　　　　　　　　　　　vbYesNoCancel + vbDefaultButton1 + vbExclamation)
　　　　If iRes = vbYes Then
　　　　　　Call Workbook_BeforeSave(False, False)
　　　　　　ThisWorkbook.Close
　　　　ElseIf iRes = vbNo Then
　　　　　　mcMenu.Delete
　　　　　　ThisWorkbook.Saved = True
　　　　　　ThisWorkbook.Close
　　　　Else
　　　　　　Call AddCustomMenu
　　　　End If
　　End If
End Sub

Private Sub mApp_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)
　　' このブック以外ではカスタムメニューを表示させない
　　On Error Resume Next
　　If Not mcMenu Is Nothing Then
　　　　If Wb Is ThisWorkbook Then
　　　　　　mcMenu.Visible = True
　　　　Else
　　　　　　mcMenu.Visible = False
　　　　End If
　　End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
　　' マクロ無効対策
'　　On Error Resume Next
　　Cancel = True
　　With Application
　　　　.EnableEvents = False
　　　　.ScreenUpdating = False
　　End With
　　With ThisWorkbook
　　　　.IsAddin = True
　　　　.Protect Password:=BOOK_PASSKEY, Windows:=True
　　　　.Save
　　　　.Unprotect Password:=BOOK_PASSKEY
　　　　.IsAddin = False
　　　　.Saved = True
　　End With
　　With Application
　　　　.ScreenUpdating = True
　　　　.EnableEvents = True
　　End With
End Sub

Public Sub 管理者専用()
　　Dim sPass　　 As String
　　Dim iErrCount As Integer
　　Dim iMode　　 As Variant
　　On Error Resume Next
　　Do While iErrCount < 3
　　　　sPass = InputBox("Caps キーや Numlock に注意して下さい", "管理者パスワード")
　　　　If sPass = ADMIN_PASSKEY Then
　　　　　　iMode = InputBox("1: 全シート保護" & vbLf & "2: 全シート保護解除", _
　　　　　　　　　　　　　　 "管理者メニュー")
　　　　　　If Val(iMode) = 2 Then
　　　　　　　　Call SheetUnProtect
　　　　　　　　MsgBox "シート保護解除しました", vbInformation
　　　　　　Else
　　　　　　　　Call SheetProtect
　　　　　　　　MsgBox "シート保護しました", vbInformation
　　　　　　End If
　　　　　　Exit Sub
　　　　Else
　　　　　　Call SheetProtect
　　　　　　iErrCount = iErrCount + 1
　　　　End If
　　Loop
　　MsgBox "認証に失敗しました", vbCritical
End Sub

' // 画像を挿入します
Private Sub InsertPic()
　　Dim vFnames　As Variant
　　Dim vFname　 As Variant
　　Dim sngZoom　As Single
　　Dim Pic　　　As Picture
　　Dim sngW　　 As Single
　　Dim sngH　　 As Single
　　Dim iOffet　 As Integer
　　On Error Resume Next
　　vFnames = Application.GetOpenFilename( _
　　　　　　　FileFilter:="Image ファイル, *.jpg;*.bmp;*.gif", _
　　　　　　　Title:="画像ファイルを指定して下さい", _
　　　　　　　MultiSelect:=True)
　　If IsArray(vFnames) Then
　　　　Application.ScreenUpdating = False
　　　　' ActiveSheet の保護を解除
　　　　Call SheetUnProtect(ActiveSheet)
　　　　With Selection
　　　　　　sngW = .Width
　　　　　　sngH = .Height
　　　　End With
　　　　sngZoom = CSng(Application.CommandBars.ActionControl.Parameter)
　　　　iOffet = 0
　　　　For Each vFname In vFnames
　　　　　　Set Pic = ActiveSheet.Pictures.Insert(vFname)
　　　　　　Pic.Placement = xlFreeFloating
　　　　　　Pic.ShapeRange.LockAspectRatio = msoTrue
　　　　　　Pic.Locked = False
　　　　　　With Pic.ShapeRange
　　　　　　　　Select Case sngZoom
　　　　　　　　　　Case 0:　.Height = sngH
　　　　　　　　　　Case 1:　.Width = sngW
　　　　　　　　　　Case 2:
　　　　　　　　　　　　.LockAspectRatio = msoFalse
　　　　　　　　　　　　.Width = sngW
　　　　　　　　　　　　.Height = sngH
　　　　　　　　　　Case 10 To 400 ' 10～400% を有効とする
　　　　　　　　　　　　.Height = .Height * sngZoom / 100#
　　　　　　　　End Select
　　　　　　　　.IncrementTop CSng(10 * iOffet)
　　　　　　　　.IncrementLeft CSng(10 * iOffet)
　　　　　　　　iOffet = iOffet + 1
　　　　　　End With
　　　　　　Set Pic = Nothing
　　　　Next
　　End If
　　' ActiveSheet を保護
　　Call SheetProtect(ActiveSheet)
　　If mApp Is Nothing Then Set mApp = Application
End Sub

' // セルの右クリックメニューにオリジナルメニューを追加
Private Sub AddCustomMenu()
　　Dim Cmb　　 As CommandBar
　　Dim sAction As String
　　Set Cmb = Application.CommandBars("Cell")
　　On Error Resume Next
　　Cmb.Controls("画像の挿入(&D)").Delete
　　Set mcMenu = Cmb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
　　With mcMenu
　　　　.Caption = "画像の挿入(&D)"
　　　　.BeginGroup = True
　　　　sAction = "ThisWorkbook.InsertPic"
　　　　With .Controls.Add(Type:=msoControlButton)
　　　　　　.Caption = "選択範囲の縦を基準にする(&1)"
　　　　　　.OnAction = sAction
　　　　　　.Parameter = 0
　　　　End With
　　　　With .Controls.Add(Type:=msoControlButton)
　　　　　　.Caption = "選択範囲の幅を基準にする(&2)"
　　　　　　.OnAction = sAction
　　　　　　.Parameter = 1
　　　　End With
　　　　With .Controls.Add(Type:=msoControlButton)
　　　　　　.Caption = "選択範囲の縦横に合わせる(&3)"
　　　　　　.OnAction = sAction
　　　　　　.Parameter = 2
　　　　End With
　　　　With .Controls.Add(Type:=msoControlButton)
　　　　　　.Caption = "原寸(&4)"
　　　　　　.OnAction = sAction
　　　　　　.Parameter = 100
　　　　End With
　　　　With .Controls.Add(Type:=msoControlButton)
　　　　　　.Caption = "75%縮小(&5)"
　　　　　　.OnAction = sAction
　　　　　　.Parameter = 75
　　　　End With
　　　　With .Controls.Add(Type:=msoControlButton)
　　　　　　.Caption = "50%縮小(&6)"
　　　　　　.OnAction = sAction
　　　　　　.Parameter = 50
　　　　End With
　　　　With .Controls.Add(Type:=msoControlButton)
　　　　　　.Caption = "25%縮小(&7)"
　　　　　　.OnAction = sAction
　　　　　　.Parameter = 25
　　　　End With
　　End With
　　Set Cmb = Nothing
　　If mApp Is Nothing Then Set mApp = Application
　　On Error GoTo 0
End Sub

' // シートに対しパス付き保護をかけます
Private Sub SheetProtect(Optional Wst As Worksheet)
　　' 引数：[Wst] シートオブジェクト。省略するとブック内の全シート
　　Dim Sh　As Worksheet
　　On Error Resume Next
　　If Not Wst Is Nothing Then
　　　　Wst.Protect Password:=PASSKEY, UserInterfaceOnly:=True
　　Else
　　　　For Each Sh In ThisWorkbook.Worksheets
　　　　　　' 今回は画像を保護しない
　　　　　　Sh.Protect Password:=PASSKEY, UserInterfaceOnly:=True, DrawingObjects:=False
　　　　Next
　　End If
End Sub

' // シートの保護を解除します
Private Sub SheetUnProtect(Optional Wst As Worksheet)
　　' 引数：[Wst] シートオブジェクト。省略するとブック内の全シート
　　Dim Sh　As Worksheet
　　On Error Resume Next
　　If Not Wst Is Nothing Then
　　　　Wst.Unprotect Password:=PASSKEY
　　Else
　　　　For Each Sh In ThisWorkbook.Worksheets
　　　　　　Sh.Unprotect Password:=PASSKEY
　　　　Next
　　End If
End Sub

お礼

ご回答ありがとうございます。
VBAのコードまで載せて頂いて大変助かります。
まだVBAは触れた事がなく、分からない点もございますので
導入の仕方から勉強を続けてこちらのコードを使わせて頂こうと
考えております。

回答No.1

mshr1962

シートの保護で「オブジェクト」のチェックをはずせば
画像の挿入と調整は出来ますが．．．

お礼

アドバイスありがとうございます。
私のExcel2000では、シートの保護から「オブジェクト」の
チェックを外した状態で写真の挿入が出来ませんでした。
（既に挿入された写真の調整は可能でした。）
私の設定が何かおかしいのでしょうか・・・
また、運用上都度ツールメニューから保護の解除や設定は
本文の通り避けられればと思っています。