- ベストアンサー
エクセルでシートを保護するマクロの関数化
- エクセル(Ver.2016)シートで入力されたセルだけに保護をかけるマクロの関数化方法
- 保護対象の行数と列数が異なるシートでも関数で使えるようマクロ化する方法
- 関数=HOGO(範囲)、もしくは=HOGO(範囲、パスワード)のような使い方をする方法
- みんなの回答 (5)
- 専門家の回答
関連するQ&A
- エクセルでマクロを別のbookにコピペしたら不具合
いつもお世話になっております。 先日ここで下記のマクロを教わって非常に感動して使い始めて、今日は他のbookへも展開しようとしたのですが、何故かコピペしたbookではエラーがでて動きません。 何度もの試行錯誤で、保護範囲に結合セルが入った場合エラーになることが分かって以降順調に使えていたのですが。 > With ThisWorkbook.Sheets(MySheet) が黄色にハイライトになります。 bookやシートを特定するようなコードは無いように思うのですが。 何が悪いのでしょう? 問題ないbookとどこが違うのでしょう? =================================== Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Const RowS = 16 'ロック範囲開始行 Const RowE = 500 'ロック範囲終了行’ Const ColS = 1 'ロック開始列 Const ColE = 8 'ロック終了行 Const MyPassword = "" 'パスワード(省略可) Const MySheet = "入力表" '保護したいシート名 Dim RowCnt As Long Dim ColCnt As Long With ThisWorkbook.Sheets(MySheet) .Unprotect Password:=MyPassword For RowCnt = RowS To RowE For ColCnt = ColS To ColE If .Cells(RowCnt, ColCnt).Value <> "" Then .Cells(RowCnt, ColCnt).Locked = True Else .Cells(RowCnt, ColCnt).Locked = False End If Next ColCnt Next RowCnt .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _ Password:=MyPassword End With End Sub =====================================
- ベストアンサー
- Excel(エクセル)
- エクセルで1つのマクロを複数のシートに適用したい
いつもお世話になっております。 以前ここで入力セルはファイル保存時に自動で保護かかるように、下記のコードを教わって便利に使い始めたのでですが、同じBookの複数のシート、あるいは一括で全てのシートで有効にしたいのですが。(この機能をデフォルトで選択機能にしていないのはおかしい位に思い始めています。) シート毎に範囲名を指定して、This Workbookにマクロを登録する必要があるのでしょうか? Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Const MyPassword = "" 'パスワード(省略可) Dim RowCnt As Long Dim ColCnt As Long Dim MyCell As Range With ThisWorkbook.Sheets(1) .Unprotect Password:=MyPassword For Each MyCell In Range("保護範囲") If MyCell.Value <> "" Then MyCell.Locked = True Else MyCell.Locked = False End If Next MyCell .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _ Password:=MyPassword End With End Sub
- ベストアンサー
- Excel(エクセル)
- エクセルで2つのマクロを結合したい
毎度お世話名なっております。 以前ここで教えてもらった保存時に全シートの入力済みセルに自動で保護がかかる<マクロ1>を教えてえもらって非常に多くのBookに採用しているのですが、今回同じBookの「計算表」シートの特定のいくつかのセルだけ保護がかからないようにしたく試行錯誤で2つのマクロをつなげてみたのですが情けないことに期待通りに動かず。 単に最初のマクロのEnd Subを削除しただけではうまくいかず。 どなたかHELPお願い致します。 <マクロ1> Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Const MyPassword = "" 'パスワード(省略可) Dim sh As Worksheet On Error Resume Next For Each sh In Worksheets sh.Unprotect Password:=MyPassword With sh.Cells '全セルのロックを外す .Locked = False '定数が含まれているセルにロックを掛ける .SpecialCells(xlCellTypeConstants).Locked = True '数式が含まれているセルにロックを掛ける .SpecialCells(xlCellTypeFormulas).Locked = True End With sh.Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True, Password:=MyPassword Next On Error GoTo 0 End Sub ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub 保護解除() <マクロ2> ' 保護解除 Macro '' Sheets("計算表").Select Range("C6:D6").Select ActiveSheet.Unprotect End Sub
- ベストアンサー
- Excel(エクセル)
- エクセルシートの無効リンクの確認
HohoPapa-さん いつもいつもお世話になっております。 さて、以前同じ質問(2019/1/10)に下記のご回答を頂いて、今月に入って一覧表のリンク切れを修正すべく試してみたのですが、リンクが生きているのに「ファイルなし」とノイズがかなりの数発生しました。 ちなみに385件のファイル無しが抽出されますが、155件はリンクが生きていました。 (ご回答いただいた時点では、12月に表を配布した後だったのでいくつかのリンク切れを確認してうまくいくと思ってしまいました) いつもながらの負んぶに抱っこの質問で恐縮ですが何か抽出精度を上げるアドバイスいただけたら幸いです。 1500件の表から385件の確認で済むのでこれでもかなりありがたいのですが。。。 Option Explicit '// リンク状況確認 Sub LinkCheck() Dim Rowcnt As Long Dim wklink As String With ThisWorkbook.Sheets(1) Rowcnt = 2 Do If .Cells(Rowcnt, 4).Value = "" Then Exit Do Worksheets(2).Cells(Rowcnt, 1) = .Cells(Rowcnt, 4).Value Worksheets(2).Cells(Rowcnt, 2) = .Cells(Rowcnt, 4).Address If .Cells(Rowcnt, 4).Hyperlinks.Count > 0 Then wklink = .Cells(Rowcnt, 4).Hyperlinks(1).Address Worksheets(2).Cells(Rowcnt, 4) = wklink If FileExists(wklink) = True Then Worksheets(2).Cells(Rowcnt, 3) = "ファイルあり" Else Worksheets(2).Cells(Rowcnt, 3) = "ファイル無し" End If Else Worksheets(2).Cells(Rowcnt, 3) = "リンク未設定" End If Rowcnt = Rowcnt + 1 Loop End With End Sub '// ファイル有無判定関数 Function FileExists(ChkFile As String) As Boolean FileExists = True On Error GoTo ErrorHandler ' エラー処理ルーチンを定義 FileDateTime (ChkFile) On Error GoTo 0 ' エラーのトラップを無効にします。 Exit Function ' エラー処理ルーチンが実行されないように Sub を終了 ErrorHandler: ' エラー処理ルーチン FileExists = False Resume Next End Function
- ベストアンサー
- Excel(エクセル)
- エクセルで、シートを非表示のままマクロを実行するには?
エクセル初心者です。 Sheet1で、マクロの実行ボタンがあり、Sheet2で、データを編集して、 Sheet1に結果の一覧を表示させるマクロなのですが、 Sheet2は非表示のままマクロを実行したいのですが、うまくいかず、 Sheet2を表示して、実行するとうまくいくため、 一時的にシートを表示させるようにしてみたのですが、 Sheets("Sheet2").Range(Cells(2, 28), Cells(rowCnt, 37)).Insert Shift:=xlDown で、アプリケーション定義・オブジェクト定義エラーになります。 どなたかご指南下さい。 Private Sub EDITSLINF() Dim rowCnt As Long Application.ScreenUpdating = False Worksheets("製造記録一覧 (edit1)").Visible = True Sheets("Sheet2").Range("AB2:AK300").ClearContents '追加レコード抽出&コピー&ペースト Sheets("Sheet2").Range("Q1:Z300").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "AP1:AP2"), CopyToRange:=Sheets("Sheet2").Range("AB1:AK1"), Unique:=False '既存レコードコピー&ペースト rowCnt = Sheets("Sheet2").Range("O1") Sheets("Sheet2").Range(Cells(2, 28), Cells(rowCnt, 37)).Insert Shift:=xlDown Sheets("Sheet2").Range(Cells(2, 28), Cells(rowCnt, 37)).Interior.ColorIndex = xlNone Sheets("Sheet2").Range(Cells(2, 2), Cells(rowCnt, 11)).Copy Sheets("Sheet2").Range("AB2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Worksheets("Sheet2").Visible = False 'メインシートへコピー Application.CutCopyMode = False Sheets("Sheet2").Range("AB2:AJ300").Copy Sheets("Sheet1").Range("K4").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのグラフの不動化(3)
この質問は先ほど締め切った質問のご回答への追加の質問になります。 何度もすみません。 一応不具合の詳細パターンを検証しようと再度ファイルを開いてみたら同じエラーが発生しました。 原因は、ファイル保存時に空白セル以外に保護がかかる下記のVBAのせいだと思います。 (一部当方で追加した不細工なコードも入っています) 単純にこのVBAを削除すれば良いのですが、このVBAは今回の課題よりもはるかに優先すべきマクロで現行の全てのBookに入れて有りますので削除やシート操作時の無効化は検討外なのですが、何とかなりませんかね!? 無理ならこちらを諦めますのでご容赦!! 従来は上の何行目かを固定表示にしてその上部の固定部分に小さなグラフを置いていました。 入力者がノートPCなので入力時の表示範囲が相当に小さくなってしまうので、グラフタイトルが不要なグラフはタイトルを削除し、タイトルが必要になったら「グラフデサイン」(グラフの書式設定タブ)からタイトルを追加していました。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Sheets("成績表(提出)").Select Range("A1").Select Selection.ClearContents Sheets("入力表").Select Range("D2:L2").Select Selection.ClearContents Const MyPassword = "" 'パスワード(省略可) Dim sh As Worksheet On Error Resume Next For Each sh In Worksheets sh.Unprotect Password:=MyPassword With sh.Cells '全セルのロックを外す .Locked = False '定数が含まれているセルにロックを掛ける .SpecialCells(xlCellTypeConstants).Locked = True '数式が含まれているセルにロックを掛ける .SpecialCells(xlCellTypeFormulas).Locked = True End With sh.Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True, Password:=MyPassword Next On Error GoTo 0 Sheets("入力表").Select End Sub
- ベストアンサー
- Excel(エクセル)
- エクセルのマクロで
お世話になります 下記のマクロで実行した所 100まで書式設定で保護、ロックしたいのですが b3:l3はロックするものの 4行目以降はロックしません どうしたらいいでしょうか もう1つ、このシートはいつもc3からはじめたいのですが If ActiveCell.Value >= "" Then の部分はどうしたらいいでしょうか よろしくおねがいいたします 初心者でバカな質問ですみません Sub マクロ1() Dim i As Integer For i = 1 To 100 If ActiveCell.Value >= "" Then Range("B3:l3").Select Selection.Locked = True Selection.FormulaHidden = False End If ActiveCell.Offset(1, 0).Select Next End Sub
- ベストアンサー
- Visual Basic
- エクセル シートを保護してる時のセル結合
エクセル2010を使用しています。 仕事の成果を一定の様式に記入してもらいます。書式、関数などを変更してもらいたくないのでシートに保護をかけました。 記入してもらうところだけセルのロックをはずし入力OKに設定しました。 しかし、シートの保護をかけるとロックをはずしててもセルの結合はできないんですね。なので、過去の質問からシートの保護がかかっていてもマクロですべての操作をしようできるというマクロ↓を参考にしてみました。 Sub seru() ActiveSheet.Protect UserInterFaceOnly:=True End Sub これと、セルを結合するマクロ↓を考えたのですが、どのように2つをくっつけたらいいのかがわかりません。 If TypeName(Selection)="Range"and Selection.Cells.Count>1 Then Selection.Merge ActiveSheet.Protect,AllowFormattingCells:=True End If 何かぬけているのかマクロを実行しても全く働いてくれません。 どうかよろしくです。
- ベストアンサー
- その他MS Office製品
- エクセル マクロ チェックボックス
sheet1にチェックボックスが3つあり、マクロを実行するコマンドボタンが1つあります。 チェックボックスにレ点を入れることにより、sheet4のデータからsheet2にグラフを作成しようと考えてますが、エラーが出てしまい解決できません。 どのように訂正したらいいのか教えて頂けないでしょうか。 Private Sub CommandButton1_Click() Dim GraphRange As String Dim Graph As ChartObject Dim lastRow As Long Set Graph = Sheets("sheet2").ChartObjects.Add(150, 27, 350, 200) lastRow = Sheets("sheet4").Range("A" & Rows.Count).End(xlUp).Row GraphRange = Sheets("sheet4").Range(Cells(1, 1), Cells(lastRow, 1)).Value If Sheets("sheet1").CheckBox1.Value = True Then 'CheckBox1にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 2), Cells(lastRow, 2)).Value End If If Sheets("sheet1").CheckBox2.Value = True Then 'CheckBox2にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 3), Cells(lastRow, 3)).Value End If If CheckBox3.Value = True Then 'CheckBox3にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 4), Cells(lastRow, 4)).Value End If Graph.Chart.ChartWizard Source:=Sheets("sheet4").Range(GraphRange).Value, _ Gallery:=xlLine, Format:=1, PlotBy:=xlColumns, _ CategoryLabels:=1, SeriesLabels:=1, HasLegend:=True End Sub
- ベストアンサー
- オフィス系ソフト
- Excel 改ページのマクロ
同シート内で改ページを設定するマクロを、ここで教えてもらったのですが、改ページを判断するデータの列が関数(vlookup)で持ってきたデータの場合にうまく機能しません。下のマクロに手を加えれば可能でしょうか? Sub Macro4() Const col As String = "A" '改ページを判断するデータの列名 Dim idx As Long Dim sv sv = Cells(1, col).Value For idx = 1 To Cells(65536, col).End(xlUp).Row If Cells(idx, col).Value <> sv Then ActiveSheet.HPageBreaks.Add Before:=Rows(idx) sv = Cells(idx, col).Value End If Next idx End Sub
- ベストアンサー
- オフィス系ソフト
お礼
思った通りの保護ができるようになりました。 何より最初のご回答で、対策が取れる事が早期に分かり助かりました。 本当に何度もご丁寧なご指導に感謝いたします!!!
補足
全く新しくTEST用Bookを作り、最初からやってみたらうまくいきました。 この方法はマクロ画面はC&Pだけで内容をいじらずにすむので当方にとっては非常にありがたい改良版です。 また、確かに保護範囲の大きさによって保存時間が非常に長くなることも試してみました。 行だけを30行程度指定しただけで10秒?(待てない)程度かかりました。(作業中は「応答なし」との表示が出ました。) 10列X500行だと2-3秒(許容範囲)で保存が終了しました。 最初のマクロで20列X500行で統一し必要に応じてマニュアルで範囲指定するか、改良版で都度範囲指定するかのどちらかでやっていくことにします。