• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：行ごとに保護するマクロにパスワードを付けたい）

行ごとに保護するマクロにパスワードを付けたい

doara_2011の回答

  • ベストアンサー
回答No.1

>ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True を以下のように ActiveSheet.Protect Password:="12345", DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True パスワードを引数で渡せばOKです。 解除も Activesheet.Unprotect Password:="12345" でできます。 ただ、デフォルトですべてのセルはロックされているので、このままだと 一行に承認と書くと、シート全体が保護されて書き換えられなくなります。 マクロの実行前に、まず全てを選択してセルのロックを外しておくこと。

wyoco
質問者

お礼

ここに書けば良かったんですね！勉強になりました。 お陰さまで希望通りになりました(^^♪ 本当にどうもありがとうございました！

この回答がついた質問に戻る
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. その他MS Office製品

関連するQ&A

  • 保護されているシートでマクロ実行するとエラー

    Excel2010で勤務表を作っています。 A列にとある文字列（承認）と入力すると、その行が保護されるマクロを、下記URLからコピペして使わせて頂いてます。 http://questionbox.jp.msn.com/qa3277541.html 勤務表なので、土日祝日は網掛けになるよう条件付き書式を使っています。 休暇取得した場合は網掛けを付けて、休日出勤した場合には網掛けなしにしたり出来るようマクロをマクロの自動記録で作りました。 ところが、どこかの行が保護されている状態で、セルの網掛けを変更するマクロを実行すると 「実行時エラー'1004'アプリケーション定義またはオブジェクトの定義エラーです」と出てしまいます。 保護されている行ではなく、まだ保護はされていない行に実行しています。 エラーが出ているのは網掛けマクロから出ています。 以下、今エクセルファイルにあるマクロの構文になります。 網掛けマクロは全部で4つ作りました。 １）休日出勤した際に条件付き書式をクリアして網掛けなしにするマクロです。 Sub 休日出勤() ' 条件書式クリア Selection.FormatConditions.Delete End Sub ※エラーになっている部分です。 ２）平日休んだ日に網掛けをするマクロです。 Sub 休日() ' 網掛け With Selection.Interior .ColorIndex = 0 .Pattern = xlGray16 .PatternColorIndex = xlAutomatic End With End Sub ３）２）のマクロで休日にしたけど、やっぱり出勤したという時に、１）だと網掛けなしにならなかったので、網掛けなしにするマクロを作りました。 Sub網掛けなし() ' 網掛けなし With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With End Sub ４）ごちゃごちゃいじってしまって最初の状態に戻したいと思ったので条件付き書式を再設定するマクロを作りました。が、２）の休日マクロを実行したセルは元に戻らないので仕方なく３）の網掛けなしマクロを実行しなければなりません。 Sub 書式クリア() ' 条件書式再設定 Range("A6:K36").Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=WEEKDAY($B6,2)>=6" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .Pattern = xlGray16 .PatternColorIndex = xlAutomatic .ColorIndex = xlAutomatic End With Selection.FormatConditions(1).StopIfTrue = False Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=OR(WEEKDAY($B6)=1,COUNTIF(祝日,$B6))" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .Pattern = xlGray16 .PatternColorIndex = xlAutomatic .ColorIndex = xlAutomatic End With Selection.FormatConditions(1).StopIfTrue = False End Sub ※この中のSelection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=WEEKDAY($B6,2)>=6"の部分がエラーと出ています。 ※１）から３）は網掛けしたいところ、網掛けなしにしたいところを範囲選択してから実行しなければなりません。 その他、保護を解除する際にパスワード認証が欲しかったので、「保護解除」ボタンを押すためにパスワード認証させるマクロもあります。 これは特に問題なく動いています。 ５）パスワード認証つき保護解除マクロ Sub password() Dim pw As Long pw = Application.InputBox( _ prompt:="パスワード入力", Type:=1) If pw <> "123" Then MsgBox "パスワードが違います" Exit Sub Else MsgBox "保護解除しました" ActiveSheet.Unprotect End If End Sub ６）行ごとに保護するマクロです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim r, rng As Range Set rng = Intersect(Target, Columns(1)) If Not rng Is Nothing Then If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect End If For Each r In rng If r.Value = "承認" Then r.EntireRow.Locked = True Else r.EntireRow.Locked = False End If Next r ActiveSheet.Protect DrawingObjects:=True, Contents:=True End If End Sub マクロに関してはド素人で、自動記録かWebで調べて見つけたマクロをちょっと加工して使う程度です。 どうか知恵をお貸しください。よろしくお願いします。

  • マクロ　シートの保護

    下記のマクロにおいて、A列以外のセルに文字なり数字なりを書くと、シートの保護が解除されてしまいます。 また、保護が解除されている状態でA列に20091010と入力してマクロを実行させるとシートが保護されます。 ずーっと保護された状態を続けるようにするにはどのようにすればよいですか？ Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim r As Range Dim flg As Long flg = 0 If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect flg = 1 End If If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub 'A列のみを対象　最初につなげるところ For Each r In Target Dim a As Long Dim b As String With r If Not .NumberFormatLocal = "ge.m.d" Or .Value = "" Then .NumberFormatLocal = "G/標準" 'セルの書式設定がH00.m.d形式だったら標準に戻す 'セルが　数字　　　　且　　　　　　整数　　　　且　　101以上　　且　　　　991231以下　の場合 If IsNumeric(.Value) And Int(.Value) = .Value And .Value >= 19010101 And .Value <= 20991231 Then b = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2) If IsDate(b) Then 'もしbがDateの形なら .Value = CDate(b) 'データ型を日付にする 'ここにつなげる。　変数はtmpからbに直す .NumberFormatLocal = "ggg" & _ IIf(Format(b, "e") > 9, "e年", "_0e年") & _ IIf(Month(b) > 9, "m月", "_1m月") & _ IIf(Day(b) > 9, "d日", "_1d日") If ActiveSheet.UnprotectContents = True Then ActiveSheet.Protect flg = 1 End If End If End If End With Next If flg = 1 Then ActiveSheet.Protect End Sub

  • マクロ実行が遅い・・・

    皆さんにおしえてもらいながら下記のようなマクロを組みました。 しかし、マクロを実行すると計算中が長いのです。 もしこのマクロに原因があれば教えてください。 よろしくお願いします。 －－－－－－－－－－－－－－－－－－－－－－－－－－ Sub 見積書作成() Sheets("見積書").Select '見積書シートを選択 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" Then '工数が「0」のときは Rows(i).RowHeight = 0 '行高さ「0」 End If Next For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next Dim Rng As Range Const Retu = "C" '<--- ここで「小計」の列を指定します。 For Each Rng In Range(Retu & "1", Range(Retu & "65536").End(xlUp)) If Trim(Rng.Value) = "小　　　計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub

  • VBA 範囲選択時エラー

    Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。 その後、A列からC列を範囲選択してDeleteするとデバック　「実行時エラー　 型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub

  • この場合エクセルVBAでどう書けばいいでしょうか？

    あるシートのH列で、H21からH46のあいだで"False"がある行を非表示にしたいのです。 下記の冗長なマクロでもそうなりますが、For Nextというのを使うともっと簡潔に記述できると思うのですが、初心者のためよくわかりません。ご教示ください。 また、下記の式はシートが保護されていると働きませんが、保護したシートでも動く方法があればそれもあわせて教えていただけると幸いです。 エクセルは95です。 Sub 空白行非表示() G% = Sheets("見積書").Range("H48").Value With Sheets("見積書") Rows("19:47").RowHeight = G% If Range("H21") = False Then Rows("21").EntireRow.Hidden = True End If If Range("H22") = False Then Rows("22").EntireRow.Hidden = True End If If Range("H23") = False Then Rows("23").EntireRow.Hidden = True End If If Range("H24") = False Then Rows("24").EntireRow.Hidden = True End If 途中、繰り返しのため省略 If Range("H42") = False Then Rows("42").EntireRow.Hidden = True End If If Range("H43") = False Then Rows("43").EntireRow.Hidden = True End If If Range("H44") = False Then Rows("44").EntireRow.Hidden = True End If If Range("H45") = False Then Rows("45").EntireRow.Hidden = True End If If Range("H46") = False Then Rows("46").EntireRow.Hidden = True End If End With End Sub

  • 特定文字列を含む行を削除するマクロ

    すみませんどなたか教えてください。 エクセルで商品の在庫管理をしておりまして、AP列に製品メーカー名が入っているのですが、 いくつかの（数十個）メーカーを省き削除したく思い、以下のようなマクロをググって作ってみましたが、 上手く動きませんでした。　1つのメーカーだけ記載した場合はうまく動きました。 やりたいことは1つのマクロの中に、数十個のメーカー名を記入しておき、そのメーカーを全件 検索して、AP列に文字列が含まれる場合は、その行を削除したいです。 宜しくお願い致します。 ～～～～～～ Sub DelLines1() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="softbank", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop Sub DelLines2() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="docomo", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop Sub DelLines3() Dim R As Range Do Set R = ActiveSheet.Range("AP:AP").Find(What:="au", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub

  • エクセルで特定の行をマクロで削除したい。

    Sub DelLines() Dim R As Range Do Set R = ActiveSheet.Range("A:A").Find(What:="ここにキーワード", LookAt:=xlPart) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub 上記のソースだと一つのキーワードだけなのですが、複数のキーワードを追加したいのとブック全体（複数のシートから検索）で実行させたいのですが教えていただけませんか？

  • Excelマクロについて

    先日、OKWEBで教えてもらったマクロに手を加えて作ろうとしたのですが、エラーがでて動かなくなりました。 わかる方がいましたら教えてください。 よろしくおねがいします。 Sub 見積書() Application.ScreenUpdating = False '見積書(完成)シートを選択 Sheets("見積書(完成)").Select '行の高さを「15」にする。 Rows("6:67").Select Range("F6").Activate Selection.RowHeight = 15 'S列のS6:S56をコピーしてE6:E7に貼り付ける。 Range("S6:S56").Select Selection.Copy Range("E6:E7").Select ActiveSheet.Paste '5列目(工数)が「0」のとき該当する行の高さを「0」にする。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" And Cells(i, 7).Value = "0" Then Rows(i).RowHeight = 0 End If Next '「E8:E55」の範囲を四捨五入する。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next 'C列の中に含まれる「小計」を検索しそこから6列目が「0」だったら行の高さを「0」にする。 Dim Rng As Range Const Retu = "C" For Each Rng In Range(Retu & "1", Range(Retu & "100").End(xlUp)) If Trim(Rng.Value) = "小　　　計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub

  • マクロ　実行エラー1004

    エクセル2000を使用しています。 以下のマクロを作り、19行目の”AAA”を探し、29行目で1つ前の列までロックしようとしています。 新規のエクセルで使用すると、動作しますが、肝心の組み込みたいエクセルだと動作しません。 19行目には”AAA”以外の文字列があります。 （19行目には、”AAA”は必ず1つしかありません） また、”AAA”は関数で19行目に表示されています。 実行すると最後の行のRange(Range("A29"), h.Offset(1, -1)).Locked = Trueで黄色ハイライトされ 実行エラー1004で「RangeクラスのLockedプロパティを設定できません。」を表示されます。 何か対処するよい方法があれば、教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) Dim h As Range Cells.Locked = False ActiveSheet.Protect userinterfaceonly:=True Set h = Range("19:1").Find(what:="AAA", LookIn:=xlValues, lookat:=xlWhole) If h Is Nothing Then Exit Sub If h.Column = 1 Then Exit Sub Range(Range("A29"), h.Offset(1, -1)).Locked = True End Sub

  • エクセル　マクロのいれ方

    エクセルを使って表を作っています。 自分のしたい事をするには、マクロを組まなくてはならないことが分かりました。 私はマクロは使ったことがないので、本来ならちゃんと勉強すべきなんですが、締め切りが迫ってるので、マクロのVBAを調べました。 したいのは、『ロックされているセル以外のデータをクリアにする』ということなんですが、その為には下記のVBA?を入れればいいらしいのです。 Sub UnlockCellClear() Dim Rng As Range For Each Rng In UsedRange 　　If Rng.Locked = False Then 　　　　Rng.Clear 　　　　Rng.Locked = False 　　End If Next End Sub ツール→マクロ→VBA→標準モジュール→Module1を開き、上記のVBAを入れてみましたが出来ませんでした。 そんな簡単なことじゃないんですかね？ ど 質問の説明が下手でしたら申し訳ありません。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する