Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3117 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【63991】メニューバーの非表示について らいち 10/1/8(金) 18:13 質問[未読]
【63998】Re:メニューバーの非表示について n 10/1/9(土) 16:23 発言[未読]
【64032】Re:メニューバーの非表示について らいち 10/1/11(月) 9:25 質問[未読]
【64034】Re:メニューバーの非表示について らいち 10/1/11(月) 11:44 お礼[未読]
【64035】Re:メニューバーの非表示について n 10/1/11(月) 17:16 発言[未読]
【64040】Re:メニューバーの非表示について らいち 10/1/12(火) 10:28 質問[未読]
【64041】Re:メニューバーの非表示について n 10/1/12(火) 16:04 発言[未読]
【64042】Re:メニューバーの非表示について らいち 10/1/12(火) 18:06 お礼[未読]
【64119】Re:メニューバーの非表示について らいち 10/1/20(水) 17:02 質問[未読]
【64122】Re:メニューバーの非表示について n 10/1/20(水) 20:06 発言[未読]
【64129】Re:メニューバーの非表示について n 10/1/21(木) 1:31 発言[未読]
【64134】Re:メニューバーの非表示について らいち 10/1/21(木) 14:11 質問[未読]
【64137】Re:メニューバーの非表示について n 10/1/21(木) 19:33 発言[未読]
【64138】有難う御座いました。 らいち 10/1/21(木) 19:39 お礼[未読]
【63991】メニューバーの非表示について
質問  らいち  - 10/1/8(金) 18:13 -
引用なし
パスワード
   長々と申し訳ありません。

下記のVBAをThisworkbookモジュールに組み込んで、メニューバーを
非表示にしているのですがVBAを組んだファイルを開いたまま、
VBAを組んでいないファイルを開くと、VBAを組んでいないファイル
までメニューバーが非表示となってしまいます。

また、その状態でVBAを組んでいないファイルの右上の「×」印で
閉じようとすると、閉じることが出来ずにVBAを組んだファイルに
切り替わると共に、メニューバーも表示されるようになり、困ってます。

Private Sub workbook_open()
Dim xlAPP As Application
Application.ScreenUpdating = False
Set xlAPP = Application
On Error Resume Next
xlAPP.CommandBars("Worksheet Menu Bar").Enabled = False 'メニューバーOFF
xlAPP.CommandBars("standard").Visible = False '標準OFF
xlAPP.CommandBars("drawing").Visible = False '図形描画OFF
xlAPP.CommandBars("formatting").Visible = False '書式設定OFF
xlAPP.DisplayFormulaBar = False '数式バーOFF
xlAPP.DisplayStatusBar = False 'ステータスバーOFF
ThisWorkbook.Sheets("タグ").Visible = xlSheetVeryHidden
Sheets("台帳").Activate
ActiveSheet.Unprotect
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim xlAPP As Application
Application.ScreenUpdating = False
Set xlAPP = Application
On Error Resume Next
xlAPP.CommandBars("Worksheet Menu Bar").Enabled = True 'メニューバーON
xlAPP.CommandBars("standard").Visible = True '標準ON
xlAPP.CommandBars("picture").Visible = True '図ON
xlAPP.CommandBars("drawing").Visible = True '図形描画ON
xlAPP.CommandBars("formatting").Visible = True '書式設定ON
xlAPP.DisplayFormulaBar = True '数式バーON
xlAPP.DisplayStatusBar = True 'ステータスバーON
ThisWorkbook.Sheets("タグ").Visible = xlSheetVeryHidden
Sheets("台帳").Activate
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
If Me.Saved = False Then Me.Save
End Sub


そこで、ＶＢＡが組まれているブックのThisworkbookモジュールに
下記VBAを追記しました。

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
Dim xlAPP As Application
Application.ScreenUpdating = False
Set xlAPP = Application
On Error Resume Next
xlAPP.CommandBars("Worksheet Menu Bar").Enabled = False 'メニューバーOFF
xlAPP.CommandBars("standard").Visible = False '標準OFF
xlAPP.CommandBars("drawing").Visible = False '図形描画OFF
xlAPP.CommandBars("formatting").Visible = False '書式設定OFF
xlAPP.DisplayFormulaBar = False '数式バーOFF
xlAPP.DisplayStatusBar = False 'ステータスバーOFF
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Dim xlAPP As Application
Application.ScreenUpdating = False
Set xlAPP = Application
On Error Resume Next
xlAPP.CommandBars("Worksheet Menu Bar").Enabled = True 'メニューバーON
xlAPP.CommandBars("standard").Visible = True '標準ON
xlAPP.CommandBars("picture").Visible = True '図ON
xlAPP.CommandBars("drawing").Visible = True '図形描画ON
xlAPP.CommandBars("formatting").Visible = True '書式設定ON
xlAPP.DisplayFormulaBar = True '数式バーON
xlAPP.DisplayStatusBar = True 'ステータスバーON
End Sub

その結果、、
メニューバー表示は解決しましたが、他の問題が出てきて困ってます。

それは、このVBAを組んだファイル内の指定したシートの
表内のデータをコピーして、新規bookを開き、形式選択で書式と
値を貼り付けた後、指定した名称で保存するというVBAを組んでいるのですが、
そこでエラーが発生しました。

上記のコードを入れる前後で、新規bookに手動でコピペしたところ、
入れる前までは「形式を選択して貼り付け」で「値」と「書式」を選択
出来たのですが、入れた後では「テキスト」とか「図」とか
excelからwordにコピペする時に表示される画面になり、「値」と「書式」
を選択できず、エラーが発生してしまいました。
何とかなりませんでしょうか。
【63998】Re:メニューバーの非表示について
発言  n  - 10/1/9(土) 16:23 -
引用なし
パスワード
   DisplayFormulaBarとDisplayStatusBarの設定時にCutCopyModeがFalseになるのが原因です。

>表内のデータをコピーして、新規bookを開き、形式選択で書式と
>値を貼り付けた後、指定した名称で保存するというVBAを組んでいるのですが、
>そこでエラーが発生しました。
マクロで実行しているわけですから、その中でApplication.EnableEventsプロパティを制御して
Workbook_WindowDeactivateイベントが走らないようにすれば良いです。

もしくは、
Sub test()
　　With Workbooks.Add(xlWBATWorksheet) 'ここでWindowDeactivateイベントが発生する
　　　　ThisWorkbook.Sheets("台帳").Range("A1").Copy
　　　　With .Sheets(1).Range("A1")
　　　　　　.PasteSpecial xlPasteValues
　　　　　　.PasteSpecial xlPasteFormats
　　　　End With
　　　　Application.CutCopyMode = False
　　　　.SaveAs "c:\temp\temp.xls"
　　　　.Close
　　End With
End Sub
このようにWindowDeactivateイベントの後でCopyメソッドを発行するような順番にすれば良いです。
基本的には、EnableEventsプロパティでの制御をおすすめします。

#手作業でもコピー可能にしたい場合は、ひと工夫必要です。
【64032】Re:メニューバーの非表示について
質問  らいち  - 10/1/11(月) 9:25 -
引用なし
パスワード
   nさん、ご丁寧な説明を頂き、ありがとうございます。
全くの初心者で申し訳ありません。ご指摘の内容について
どこを修正したら良いか分からなかったので、教えて頂ける
と助かります。
「台帳」シートに記載したVBAを下記します。
CutCopyModeも記載していなかったのも、問題だったのでしょうか。

Private Sub タグ作成_Click()
Dim InPt As Long
Dim c As Object
Dim myKey As String
　　Dim SaveName As String
　　Dim wb As Workbook, wkbk As Workbook
　　Set wb = ThisWorkbook
　　InPt = Application.InputBox(prompt:="No.を入力して下さい。", Type:=1)
　　If InPt = False Then Exit Sub
Application.ScreenUpdating = False
ActiveSheet.Unprotect
myKey = InPt
With ActiveSheet.Range("$c$5:$c$3000")
Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
If c Is Nothing Then
MsgBox "No." & InPt & "は登録されていません。"
Else
　　ThisWorkbook.Sheets("タグ").Visible = True
　　Sheets("タグ").Activate
　　With wb.ActiveSheet
　　　　.Range("c3").Value = InPt
　　　　.Range("B2:C16").Copy
　　End With
　　Set wkbk = Workbooks.Add
　　With wkbk.ActiveSheet
　　　　.Range("B2").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　　　　.Range("B2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　　　　.Columns("A:A").ColumnWidth = 0.5
　　　　.Columns("B:B").ColumnWidth = 10
　　　　.Columns("C:C").ColumnWidth = 50
　　　　.Columns("d:d").ColumnWidth = 0.5
　　　　.Rows("1:1").RowHeight = 5
　　　　.Rows("17:17").RowHeight = 5
　　　　.Columns("E:IV").EntireColumn.Hidden = True
　　　　.Rows("18:65536").EntireRow.Hidden = True
　　　　End With
　　　　With ActiveWindow
　　　　.DisplayGridlines = False
　　　　.DisplayHeadings = False
　　　　.DisplayOutline = False
　　　　.DisplayZeros = False
　　　　.DisplayHorizontalScrollBar = False
　　　　.DisplayVerticalScrollBar = False
　　　　.DisplayWorkbookTabs = False
　　End With
　　SaveName = "C:\Documents and Settings\123\デスクトップ\" & InPt & "タグ.xls"
　　Application.DisplayAlerts = False
　　ActiveSheet.Range("c3").Locked = True
　　ActiveSheet.Protect password:="1234"
　　ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
　　ActiveWorkbook.SaveAs Filename:=SaveName, FileFormat:=xlNormal, password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
　　wkbk.Close False
　　Sheets("タグ").Activate
　　Selection.ClearContents
　　ThisWorkbook.Sheets("タグ").Visible = xlSheetVeryHidden
　　Sheets("台帳").Activate
　　MsgBox "タグ作成しました。"
　　Set wb = Nothing
　　Set wkbk = Nothing
End If
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
▼n さん：
>DisplayFormulaBarとDisplayStatusBarの設定時にCutCopyModeがFalseになるのが原因です。
>
>>表内のデータをコピーして、新規bookを開き、形式選択で書式と
>>値を貼り付けた後、指定した名称で保存するというVBAを組んでいるのですが、
>>そこでエラーが発生しました。
>マクロで実行しているわけですから、その中でApplication.EnableEventsプロパティを制御して
>Workbook_WindowDeactivateイベントが走らないようにすれば良いです。
>
>もしくは、
>Sub test()
>　　With Workbooks.Add(xlWBATWorksheet) 'ここでWindowDeactivateイベントが発生する
>　　　　ThisWorkbook.Sheets("台帳").Range("A1").Copy
>　　　　With .Sheets(1).Range("A1")
>　　　　　　.PasteSpecial xlPasteValues
>　　　　　　.PasteSpecial xlPasteFormats
>　　　　End With
>　　　　Application.CutCopyMode = False
>　　　　.SaveAs "c:\temp\temp.xls"
>　　　　.Close
>　　End With
>End Sub
>このようにWindowDeactivateイベントの後でCopyメソッドを発行するような順番にすれば良いです。
>基本的には、EnableEventsプロパティでの制御をおすすめします。
>
>#手作業でもコピー可能にしたい場合は、ひと工夫必要です。
【64034】Re:メニューバーの非表示について
お礼  らいち  - 10/1/11(月) 11:44 -
引用なし
パスワード
   とりあえず、下記の通りにコードを追加してみたら
うまくいきました！有難う御座いました。
CutCopyModeは入れた方がいいのでしょうか。

Private Sub タグ作成_Click()
Dim InPt As Long
Dim c As Object
Dim myKey As String
　　Dim SaveName As String
　　Dim wb As Workbook, wkbk As Workbook
　　Set wb = ThisWorkbook
　　InPt = Application.InputBox(prompt:="No.を入力して下さい。", Type:=1)
　　If InPt = False Then Exit Sub
Application.ScreenUpdating = False
ActiveSheet.Unprotect
myKey = InPt
With ActiveSheet.Range("$c$5:$c$3000")
Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
If c Is Nothing Then
MsgBox "No." & InPt & "は登録されていません。"
Else
　　ThisWorkbook.Sheets("タグ").Visible = True
　　Sheets("タグ").Activate
　　With wb.ActiveSheet
　　　　.Range("c3").Value = InPt
　　　　.Range("B2:C16").Copy
　　End With

Application.EnableEvents = False

　　Set wkbk = Workbooks.Add
　　With wkbk.ActiveSheet
　　　　.Range("B2").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　　　　.Range("B2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　　　　.Columns("A:A").ColumnWidth = 0.5
　　　　.Columns("B:B").ColumnWidth = 10
　　　　.Columns("C:C").ColumnWidth = 50
　　　　.Columns("d:d").ColumnWidth = 0.5
　　　　.Rows("1:1").RowHeight = 5
　　　　.Rows("17:17").RowHeight = 5
　　　　.Columns("E:IV").EntireColumn.Hidden = True
　　　　.Rows("18:65536").EntireRow.Hidden = True
　　　　End With
　　　　With ActiveWindow
　　　　.DisplayGridlines = False
　　　　.DisplayHeadings = False
　　　　.DisplayOutline = False
　　　　.DisplayZeros = False
　　　　.DisplayHorizontalScrollBar = False
　　　　.DisplayVerticalScrollBar = False
　　　　.DisplayWorkbookTabs = False
　　End With
　　SaveName = "C:\Documents and Settings\123\デスクトップ\" & InPt & "タグ.xls"
　　Application.DisplayAlerts = False
　　ActiveSheet.Range("c3").Locked = True
　　ActiveSheet.Protect password:="1234"
　　ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
　　ActiveWorkbook.SaveAs Filename:=SaveName, FileFormat:=xlNormal, password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
　　wkbk.Close False
　　Sheets("タグ").Activate
　　ThisWorkbook.Activesheet.Range("C3").ClearContents
　　ThisWorkbook.Sheets("タグ").Visible = xlSheetVeryHidden
　　Sheets("台帳").Activate
　　MsgBox "タグ作成しました。"
　　Set wb = Nothing
　　Set wkbk = Nothing

Application.EnableEvents = True

End If
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

▼らいち さん：
>nさん、ご丁寧な説明を頂き、ありがとうございます。
>全くの初心者で申し訳ありません。ご指摘の内容について
>どこを修正したら良いか分からなかったので、教えて頂ける
>と助かります。
>「台帳」シートに記載したVBAを下記します。
>CutCopyModeも記載していなかったのも、問題だったのでしょうか。
>
>Private Sub タグ作成_Click()
>Dim InPt As Long
>Dim c As Object
>Dim myKey As String
>　　Dim SaveName As String
>　　Dim wb As Workbook, wkbk As Workbook
>　　Set wb = ThisWorkbook
>　　InPt = Application.InputBox(prompt:="No.を入力して下さい。", Type:=1)
>　　If InPt = False Then Exit Sub
>Application.ScreenUpdating = False
>ActiveSheet.Unprotect
>myKey = InPt
>With ActiveSheet.Range("$c$5:$c$3000")
>Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlWhole, _
>SearchOrder:=xlByColumns, MatchByte:=False)
>If c Is Nothing Then
>MsgBox "No." & InPt & "は登録されていません。"
>Else
>　　ThisWorkbook.Sheets("タグ").Visible = True
>　　Sheets("タグ").Activate
>　　With wb.ActiveSheet
>　　　　.Range("c3").Value = InPt
>　　　　.Range("B2:C16").Copy
>　　End With
>　　Set wkbk = Workbooks.Add
>　　With wkbk.ActiveSheet
>　　　　.Range("B2").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>　　　　.Range("B2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>　　　　.Columns("A:A").ColumnWidth = 0.5
>　　　　.Columns("B:B").ColumnWidth = 10
>　　　　.Columns("C:C").ColumnWidth = 50
>　　　　.Columns("d:d").ColumnWidth = 0.5
>　　　　.Rows("1:1").RowHeight = 5
>　　　　.Rows("17:17").RowHeight = 5
>　　　　.Columns("E:IV").EntireColumn.Hidden = True
>　　　　.Rows("18:65536").EntireRow.Hidden = True
>　　　　End With
>　　　　With ActiveWindow
>　　　　.DisplayGridlines = False
>　　　　.DisplayHeadings = False
>　　　　.DisplayOutline = False
>　　　　.DisplayZeros = False
>　　　　.DisplayHorizontalScrollBar = False
>　　　　.DisplayVerticalScrollBar = False
>　　　　.DisplayWorkbookTabs = False
>　　End With
>　　SaveName = "C:\Documents and Settings\123\デスクトップ\" & InPt & "タグ.xls"
>　　Application.DisplayAlerts = False
>　　ActiveSheet.Range("c3").Locked = True
>　　ActiveSheet.Protect password:="1234"
>　　ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
>　　ActiveWorkbook.SaveAs Filename:=SaveName, FileFormat:=xlNormal, password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
>　　wkbk.Close False
>　　Sheets("タグ").Activate
>　　Selection.ClearContents
>　　ThisWorkbook.Sheets("タグ").Visible = xlSheetVeryHidden
>　　Sheets("台帳").Activate
>　　MsgBox "タグ作成しました。"
>　　Set wb = Nothing
>　　Set wkbk = Nothing
>End If
>End With
>ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
>End Sub
>▼n さん：
>>DisplayFormulaBarとDisplayStatusBarの設定時にCutCopyModeがFalseになるのが原因です。
>>
>>>表内のデータをコピーして、新規bookを開き、形式選択で書式と
>>>値を貼り付けた後、指定した名称で保存するというVBAを組んでいるのですが、
>>>そこでエラーが発生しました。
>>マクロで実行しているわけですから、その中でApplication.EnableEventsプロパティを制御して
>>Workbook_WindowDeactivateイベントが走らないようにすれば良いです。
>>
>>もしくは、
>>Sub test()
>>　　With Workbooks.Add(xlWBATWorksheet) 'ここでWindowDeactivateイベントが発生する
>>　　　　ThisWorkbook.Sheets("台帳").Range("A1").Copy
>>　　　　With .Sheets(1).Range("A1")
>>　　　　　　.PasteSpecial xlPasteValues
>>　　　　　　.PasteSpecial xlPasteFormats
>>　　　　End With
>>　　　　Application.CutCopyMode = False
>>　　　　.SaveAs "c:\temp\temp.xls"
>>　　　　.Close
>>　　End With
>>End Sub
>>このようにWindowDeactivateイベントの後でCopyメソッドを発行するような順番にすれば良いです。
>>基本的には、EnableEventsプロパティでの制御をおすすめします。
>>
>>#手作業でもコピー可能にしたい場合は、ひと工夫必要です。
【64035】Re:メニューバーの非表示について
発言  n  - 10/1/11(月) 17:16 -
引用なし
パスワード
   >CutCopyModeは入れた方がいいのでしょうか。
Application.CutCopyMode = False
の事ですか？
今回のケースではいれなくても可ですが、
私は極力明示するようにしています。

余談ですが、ActiveSheet.Unprotectは必要ないのでは。
それにActivateしなければVisible変更も必要ありません。

Private Sub test()
　　Dim ws　 As Worksheet
　　Dim InPt As Long

　　InPt = Application.InputBox(prompt:="No.を入力して下さい。", Type:=1)
　　If InPt = False Then Exit Sub
　　If ActiveSheet.Range("$c$5:$c$3000").Find(What:=InPt, _
　　　　　　　　　　　　　　　　　　　　　　　LookIn:=xlValues, _
　　　　　　　　　　　　　　　　　　　　　　　lookat:=xlWhole, _
　　　　　　　　　　　　　　　　　　　　　　　SearchOrder:=xlByColumns, _
　　　　　　　　　　　　　　　　　　　　　　　MatchByte:=False) Is Nothing Then
　　　　MsgBox "No." & InPt & "は登録されていません。"
　　　　Exit Sub
　　End If

　　With Application
　　　　.ScreenUpdating = False
　　　　.EnableEvents = False
　　End With
　　Set ws = ThisWorkbook.Sheets("タグ")
　　ws.Range("C3").Value = InPt
　　With Workbooks.Add
　　　　With .Sheets(1)
　　　　　　ws.Range("B2:C16").Copy
　　　　　　.Range("B2").PasteSpecial Paste:=xlFormats
　　　　　　.Range("B2").PasteSpecial Paste:=xlValues
　　　　　　.Range("A:A,D:D").ColumnWidth = 0.5
　　　　　　.Columns("B:B").ColumnWidth = 10
　　　　　　.Columns("C:C").ColumnWidth = 50
　　　　　　.Rows(1).RowHeight = 5
　　　　　　.Rows(17).RowHeight = 5
　　　　　　.Columns("E:IV").Hidden = True
　　　　　　.Rows("18:65536").Hidden = True
　　　　　　.Range("c3").Locked = True
　　　　　　.Protect password:="1234"
　　　　End With
　　　　With .Windows(1)
　　　　　　.DisplayGridlines = False
　　　　　　.DisplayHeadings = False
　　　　　　.DisplayOutline = False
　　　　　　.DisplayZeros = False
　　　　　　.DisplayHorizontalScrollBar = False
　　　　　　.DisplayVerticalScrollBar = False
　　　　　　.DisplayWorkbookTabs = False
　　　　End With
　　　　.SaveAs Filename:=ThisWorkbook.Path & "\" & InPt & "タグ.xls"
　　　　.Close False
　　End With
　　ws.Range("C3").ClearContents
　　With Application
　　　　.ScreenUpdating = True
　　　　.EnableEvents = True
　　End With
　　Set ws = Nothing
　　MsgBox "タグ作成しました。"
End Sub
【64040】Re:メニューバーの非表示について
質問  らいち  - 10/1/12(火) 10:28 -
引用なし
パスワード
   nさん、本当にご丁寧に有難う御座いました。
もう一点教えて頂きたいことがあるのですが、
前回までにご相談しましたVBAでメニューバー、
ツールバーの非表示をしているのですが、シートを
何度か切り替えると、ツールのアイコンや「ファイル(F)」とか
は非表示になるのですが、それが表示された時の背景と
いいますか、空欄の状態で表示されてしまいます。
その空欄上で右クリックをすると、各ツールバーの表示や
ユーザー設定が出来てしまい、困ってます。
どうしたらよろしいでしょうか。

判り難い説明で申し訳ありません。

▼n さん：
>>CutCopyModeは入れた方がいいのでしょうか。
>Application.CutCopyMode = False
>の事ですか？
>今回のケースではいれなくても可ですが、
>私は極力明示するようにしています。
>
>余談ですが、ActiveSheet.Unprotectは必要ないのでは。
>それにActivateしなければVisible変更も必要ありません。
>
>Private Sub test()
>　　Dim ws　 As Worksheet
>　　Dim InPt As Long
>
>　　InPt = Application.InputBox(prompt:="No.を入力して下さい。", Type:=1)
>　　If InPt = False Then Exit Sub
>　　If ActiveSheet.Range("$c$5:$c$3000").Find(What:=InPt, _
>　　　　　　　　　　　　　　　　　　　　　　　LookIn:=xlValues, _
>　　　　　　　　　　　　　　　　　　　　　　　lookat:=xlWhole, _
>　　　　　　　　　　　　　　　　　　　　　　　SearchOrder:=xlByColumns, _
>　　　　　　　　　　　　　　　　　　　　　　　MatchByte:=False) Is Nothing Then
>　　　　MsgBox "No." & InPt & "は登録されていません。"
>　　　　Exit Sub
>　　End If
>
>　　With Application
>　　　　.ScreenUpdating = False
>　　　　.EnableEvents = False
>　　End With
>　　Set ws = ThisWorkbook.Sheets("タグ")
>　　ws.Range("C3").Value = InPt
>　　With Workbooks.Add
>　　　　With .Sheets(1)
>　　　　　　ws.Range("B2:C16").Copy
>　　　　　　.Range("B2").PasteSpecial Paste:=xlFormats
>　　　　　　.Range("B2").PasteSpecial Paste:=xlValues
>　　　　　　.Range("A:A,D:D").ColumnWidth = 0.5
>　　　　　　.Columns("B:B").ColumnWidth = 10
>　　　　　　.Columns("C:C").ColumnWidth = 50
>　　　　　　.Rows(1).RowHeight = 5
>　　　　　　.Rows(17).RowHeight = 5
>　　　　　　.Columns("E:IV").Hidden = True
>　　　　　　.Rows("18:65536").Hidden = True
>　　　　　　.Range("c3").Locked = True
>　　　　　　.Protect password:="1234"
>　　　　End With
>　　　　With .Windows(1)
>　　　　　　.DisplayGridlines = False
>　　　　　　.DisplayHeadings = False
>　　　　　　.DisplayOutline = False
>　　　　　　.DisplayZeros = False
>　　　　　　.DisplayHorizontalScrollBar = False
>　　　　　　.DisplayVerticalScrollBar = False
>　　　　　　.DisplayWorkbookTabs = False
>　　　　End With
>　　　　.SaveAs Filename:=ThisWorkbook.Path & "\" & InPt & "タグ.xls"
>　　　　.Close False
>　　End With
>　　ws.Range("C3").ClearContents
>　　With Application
>　　　　.ScreenUpdating = True
>　　　　.EnableEvents = True
>　　End With
>　　Set ws = Nothing
>　　MsgBox "タグ作成しました。"
>End Sub
【64041】Re:メニューバーの非表示について
発言  n  - 10/1/12(火) 16:04 -
引用なし
パスワード
   私の環境は
Windows XP pro 5.1.2600 SP3
Excel 2003 (11.8316.8221) SP2 (Office Personal)
Excel 2000 (9.0.8968) SP3
VBA Retail 6.5.1040
ですが、現象が確認できません。
そちらの環境はどうですか？

取り敢えず、少しコードを整理して様子を見てください。

'ThisWorkbookModule
Option Explicit
'---------------------------------------------------------------------
Private Sub workbook_open()
　　Me.Sheets("タグ").Visible = xlSheetVeryHidden
　　Me.Sheets("台帳").Protect
End Sub
'---------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Me.Sheets("タグ").Visible = xlSheetVeryHidden
　　With Me.Sheets("台帳")
　　　　.AutoFilterMode = False
　　　　.Protect
　　End With
　　If Me.Saved = False Then Me.Save
End Sub
'---------------------------------------------------------------------
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
　　barSet
End Sub
'---------------------------------------------------------------------
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
　　barReset
End Sub
'---------------------------------------------------------------------
Private Sub barSet()
　　On Error Resume Next
　　With Application
　　　　.ScreenUpdating = False '■
　　　　.CommandBars("Worksheet Menu Bar").Enabled = False 'メニューバーOFF
　　　　.CommandBars("standard").Visible = False　　　　　 '標準OFF
　　　　.CommandBars("picture").Visible = False　　　　　　'図ON
　　　　.CommandBars("drawing").Visible = False　　　　　　'図形描画OFF
　　　　.CommandBars("formatting").Visible = False　　　　 '書式設定OFF
　　　　.DisplayFormulaBar = False　　　　　　　　　　　　
　　　　.DisplayStatusBar = False　　　　　　　　　　　　　
　　　　.ScreenUpdating = True
　　End With
End Sub
'---------------------------------------------------------------------
Private Sub barReset()
　　On Error Resume Next
　　With Application
　　　　.ScreenUpdating = False
　　　　.CommandBars("Worksheet Menu Bar").Enabled = True 'メニューバーON
　　　　.CommandBars("standard").Visible = True　　　　　 '標準ON
　　　　.CommandBars("picture").Visible = True　　　　　　'図ON
　　　　.CommandBars("drawing").Visible = True　　　　　　'図形描画ON
　　　　.CommandBars("formatting").Visible = True　　　　 '書式設定ON
　　　　'.OnTime Now, Me.CodeName & ".test"
　　　　.DisplayFormulaBar = True
　　　　.DisplayStatusBar = True
　　　　.ScreenUpdating = True
　　End With
End Sub

上記コードでも出るようでしたら Private Sub barSet() の
■のScreenUpdating制御をコメントアウトしてください。

でも、元々"standard","picture","drawing","formatting" 『以外』のバーを表示させていたら
>各ツールバーの表示やユーザー設定が出来てしまい...
という状況は発生します。
【64042】Re:メニューバーの非表示について
お礼  らいち  - 10/1/12(火) 18:06 -
引用なし
パスワード
   ｎさん、有難う御座います。
早速試してみます。

ちなみに私の環境は
Windows XP pro 5.1.2600 SP3
Excel 2000 (9.0.3821 SR-1)
です。

▼n さん：
>私の環境は
>Windows XP pro 5.1.2600 SP3
>Excel 2003 (11.8316.8221) SP2 (Office Personal)
>Excel 2000 (9.0.8968) SP3
>VBA Retail 6.5.1040
>ですが、現象が確認できません。
>そちらの環境はどうですか？
>
>取り敢えず、少しコードを整理して様子を見てください。
>
>'ThisWorkbookModule
>Option Explicit
>'---------------------------------------------------------------------
>Private Sub workbook_open()
>　　Me.Sheets("タグ").Visible = xlSheetVeryHidden
>　　Me.Sheets("台帳").Protect
>End Sub
>'---------------------------------------------------------------------
>Private Sub Workbook_BeforeClose(Cancel As Boolean)
>　　Me.Sheets("タグ").Visible = xlSheetVeryHidden
>　　With Me.Sheets("台帳")
>　　　　.AutoFilterMode = False
>　　　　.Protect
>　　End With
>　　If Me.Saved = False Then Me.Save
>End Sub
>'---------------------------------------------------------------------
>Private Sub Workbook_WindowActivate(ByVal Wn As Window)
>　　barSet
>End Sub
>'---------------------------------------------------------------------
>Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
>　　barReset
>End Sub
>'---------------------------------------------------------------------
>Private Sub barSet()
>　　On Error Resume Next
>　　With Application
>　　　　.ScreenUpdating = False '■
>　　　　.CommandBars("Worksheet Menu Bar").Enabled = False 'メニューバーOFF
>　　　　.CommandBars("standard").Visible = False　　　　　 '標準OFF
>　　　　.CommandBars("picture").Visible = False　　　　　　'図ON
>　　　　.CommandBars("drawing").Visible = False　　　　　　'図形描画OFF
>　　　　.CommandBars("formatting").Visible = False　　　　 '書式設定OFF
>　　　　.DisplayFormulaBar = False　　　　　　　　　　　　
>　　　　.DisplayStatusBar = False　　　　　　　　　　　　　
>　　　　.ScreenUpdating = True
>　　End With
>End Sub
>'---------------------------------------------------------------------
>Private Sub barReset()
>　　On Error Resume Next
>　　With Application
>　　　　.ScreenUpdating = False
>　　　　.CommandBars("Worksheet Menu Bar").Enabled = True 'メニューバーON
>　　　　.CommandBars("standard").Visible = True　　　　　 '標準ON
>　　　　.CommandBars("picture").Visible = True　　　　　　'図ON
>　　　　.CommandBars("drawing").Visible = True　　　　　　'図形描画ON
>　　　　.CommandBars("formatting").Visible = True　　　　 '書式設定ON
>　　　　'.OnTime Now, Me.CodeName & ".test"
>　　　　.DisplayFormulaBar = True
>　　　　.DisplayStatusBar = True
>　　　　.ScreenUpdating = True
>　　End With
>End Sub
>
>上記コードでも出るようでしたら Private Sub barSet() の
>■のScreenUpdating制御をコメントアウトしてください。
>
>でも、元々"standard","picture","drawing","formatting" 『以外』のバーを表示させていたら
>>各ツールバーの表示やユーザー設定が出来てしまい...
>という状況は発生します。
【64119】Re:メニューバーの非表示について
質問  らいち  - 10/1/20(水) 17:02 -
引用なし
パスワード
   ｎさん、
ScreenUpdating制御をコメントアウトしたら不具合は解消しました。
メニューバーや全コマンドバー、各ツールバー、ユーザー設定なども
含めて、すべて非表示にすることはできますでしょうか。
調べてみると、下記コメントを入れると理想に近い状態になるのです
が右クリックまで使えず、アクティブブック以外にも反映されるので
使っていないです。他に良い方法はありますか。

Sub CommandBars切り替え()
　　Dim myCBar As CommandBar
　　For Each myCBar In CommandBars
　　　　myCBar.Enabled = Not myCBar.Enabled
　　Next
End Sub

▼らいち さん：
>ｎさん、有難う御座います。
>早速試してみます。
>
>ちなみに私の環境は
>Windows XP pro 5.1.2600 SP3
>Excel 2000 (9.0.3821 SR-1)
>です。
>
>▼n さん：
>>私の環境は
>>Windows XP pro 5.1.2600 SP3
>>Excel 2003 (11.8316.8221) SP2 (Office Personal)
>>Excel 2000 (9.0.8968) SP3
>>VBA Retail 6.5.1040
>>ですが、現象が確認できません。
>>そちらの環境はどうですか？
>>
>>取り敢えず、少しコードを整理して様子を見てください。
>>
>>'ThisWorkbookModule
>>Option Explicit
>>'---------------------------------------------------------------------
>>Private Sub workbook_open()
>>　　Me.Sheets("タグ").Visible = xlSheetVeryHidden
>>　　Me.Sheets("台帳").Protect
>>End Sub
>>'---------------------------------------------------------------------
>>Private Sub Workbook_BeforeClose(Cancel As Boolean)
>>　　Me.Sheets("タグ").Visible = xlSheetVeryHidden
>>　　With Me.Sheets("台帳")
>>　　　　.AutoFilterMode = False
>>　　　　.Protect
>>　　End With
>>　　If Me.Saved = False Then Me.Save
>>End Sub
>>'---------------------------------------------------------------------
>>Private Sub Workbook_WindowActivate(ByVal Wn As Window)
>>　　barSet
>>End Sub
>>'---------------------------------------------------------------------
>>Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
>>　　barReset
>>End Sub
>>'---------------------------------------------------------------------
>>Private Sub barSet()
>>　　On Error Resume Next
>>　　With Application
>>　　　　.ScreenUpdating = False '■
>>　　　　.CommandBars("Worksheet Menu Bar").Enabled = False 'メニューバーOFF
>>　　　　.CommandBars("standard").Visible = False　　　　　 '標準OFF
>>　　　　.CommandBars("picture").Visible = False　　　　　　'図ON
>>　　　　.CommandBars("drawing").Visible = False　　　　　　'図形描画OFF
>>　　　　.CommandBars("formatting").Visible = False　　　　 '書式設定OFF
>>　　　　.DisplayFormulaBar = False　　　　　　　　　　　　
>>　　　　.DisplayStatusBar = False　　　　　　　　　　　　　
>>　　　　.ScreenUpdating = True
>>　　End With
>>End Sub
>>'---------------------------------------------------------------------
>>Private Sub barReset()
>>　　On Error Resume Next
>>　　With Application
>>　　　　.ScreenUpdating = False
>>　　　　.CommandBars("Worksheet Menu Bar").Enabled = True 'メニューバーON
>>　　　　.CommandBars("standard").Visible = True　　　　　 '標準ON
>>　　　　.CommandBars("picture").Visible = True　　　　　　'図ON
>>　　　　.CommandBars("drawing").Visible = True　　　　　　'図形描画ON
>>　　　　.CommandBars("formatting").Visible = True　　　　 '書式設定ON
>>　　　　'.OnTime Now, Me.CodeName & ".test"
>>　　　　.DisplayFormulaBar = True
>>　　　　.DisplayStatusBar = True
>>　　　　.ScreenUpdating = True
>>　　End With
>>End Sub
>>
>>上記コードでも出るようでしたら Private Sub barSet() の
>>■のScreenUpdating制御をコメントアウトしてください。
>>
>>でも、元々"standard","picture","drawing","formatting" 『以外』のバーを表示させていたら
>>>各ツールバーの表示やユーザー設定が出来てしまい...
>>という状況は発生します。
【64122】Re:メニューバーの非表示について
発言  n  - 10/1/20(水) 20:06 -
引用なし
パスワード
   ThisWorkbook に 変数記録用のシートを追加してください。
下記コードの例では、 "config" という名前のシートを追加したものとします。
普段は非表示（xlSheetVeryHidden）にしておいても構いません。
先に提示したコードを下記と入れ替えてください。

Private Sub barSet()
　　Dim i As Long
　　Dim c As Long
　　Dim v(1 To 256)
　　
　　With Application
　　　　.CommandBars("Worksheet Menu Bar").Enabled = False
　　　　For i = 2 To .CommandBars.Count
　　　　　　With .CommandBars(i)
　　　　　　　　If .Visible Then
　　　　　　　　　　.Visible = False
　　　　　　　　　　c = c + 1
　　　　　　　　　　v(c) = i
　　　　　　　　End If
　　　　　　End With
　　　　Next
　　　　.DisplayFormulaBar = False
　　　　.DisplayStatusBar = False
　　End With
　　Me.Sheets("config").Rows(1).Value = v
End Sub
'---------------------------------------------------------------------
Private Sub barReset()
　　Dim v, vi

　　With Me.Sheets("config")
　　　　v = .Range(.Cells(1), .Cells(256).End(xlToLeft).Offset(, 1)).Value
　　End With
　　ReDim Preserve v(1 To 1, 1 To UBound(v, 2) - 1)
　　With Application
　　　　.CommandBars("Worksheet Menu Bar").Enabled = True
　　　　If Not IsEmpty(v(1, 1)) Then
　　　　　　For Each vi In v
　　　　　　　　.CommandBars(CLng(vi)).Visible = True
　　　　　　Next
　　　　End If
　　　　.DisplayFormulaBar = True
　　　　.DisplayStatusBar = True
　　End With
End Sub

barSetする時にCommandBarsをLoopして表示されていれば非表示にします。
と同時に"config"シートの１行目に、表示CommandBarのIndexを記録します。
barReset時にその記録を読み込んで表示します。

こんな感じで表示状態に応じて対応すれば良いと思います。
【64129】Re:メニューバーの非表示について
発言  n  - 10/1/21(木) 1:31 -
引用なし
パスワード
   >With Me.Sheets("config")
>　　v = .Range(.Cells(1), .Cells(256).End(xlToLeft).Offset(, 1)).Value
>End With
>ReDim Preserve v(1 To 1, 1 To UBound(v, 2) - 1)
なんかここ小癪ですね...orz

Private Sub barReset()
　　Dim n As Long
　　Dim v, vi

　　With Me.Sheets("config")
　　　　n = .Cells(256).End(xlToLeft).Column
　　　　If n = 1 Then
　　　　　　If Not IsEmpty(.Cells(1).Value) Then
　　　　　　　　v = Array(.Cells(1).Value)
　　　　　　End If
　　　　Else
　　　　　　v = .Cells(1).Resize(, n).Value
　　　　End If
　　End With
　　With Application
　　　　.CommandBars("Worksheet Menu Bar").Enabled = True
　　　　If Not IsEmpty(v) Then
　　　　　　For Each vi In v
　　　　　　　　.CommandBars(CLng(vi)).Visible = True
　　　　　　Next
　　　　End If
　　　　.DisplayFormulaBar = True
　　　　.DisplayStatusBar = True
　　End With
End Sub
こっちがいいかな。
【64134】Re:メニューバーの非表示について
質問  らいち  - 10/1/21(木) 14:11 -
引用なし
パスワード
   有難う御座います。早速やってみます。

あと今回までにご相談しました下記コードの中で
InPtに入力された値をC3セルに入れ、VLOOKUP関数を使って表示し、
表示された内容を新規ブックにコピーしていましたが
VLOOKUP関数の表記が長すぎて、入力できずに困ってます。
これもVBAコードに入れ込みたいのですが、どうすれば
よろしいでしょうか。

・セルに入力したVLOOKUP関数
=IF($C$3="","",TRIM(CONCATENATE(VLOOKUP($C$3,台帳!$C$5:$CP$3000,24,FALSE),
VLOOKUP($C$3,台帳!$C$5:$CP$3000,25,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,26,FALSE),
VLOOKUP($C$3,台帳!$C$5:$CP$3000,27,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,28,FALSE),
VLOOKUP($C$3,台帳!$C$5:$CP$3000,29,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,30,FALSE),
VLOOKUP($C$3,台帳!$C$5:$CP$3000,31,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,32,FALSE)," ",
VLOOKUP($C$3,台帳!$C$5:$CP$3000,33,FALSE),VLOOKUP($C$3,台帳!$C$5:$CP$3000,34,FALSE)･･･VLOOKUP($C$3,台帳!$C$5:$CP$3000,64,FALSE)

・ご相談しているVBAコード
Private Sub タグ作成_Click()
　　Dim ws As Worksheet
　　Dim InPt As Long
　　InPt = Application.InputBox(prompt:="No.を入力して下さい。", Type:=1)
　　If InPt = False Then Exit Sub
　　If ActiveSheet.Range("$c$5:$c$3000").Find(What:=InPt, _
　　　　　　　　　　　　　　　　　　　　　　　LookIn:=xlValues, _
　　　　　　　　　　　　　　　　　　　　　　　lookat:=xlWhole, _
　　　　　　　　　　　　　　　　　　　　　　　SearchOrder:=xlByColumns, _
　　　　　　　　　　　　　　　　　　　　　　　MatchByte:=False) Is Nothing Then
　　　　MsgBox "No." & InPt & "は登録されていません。"
　　　　Exit Sub
　　End If
　　Application.EnableEvents = False
　　Set ws = ThisWorkbook.Sheets("タグ")
　　ws.Range("C3").Value = InPt
　　With Workbooks.Add
　　　　With .Sheets(1)
　　　　　　ws.Range("B2:C16").Copy
　　　　　　.Range("B2").PasteSpecial Paste:=xlFormats
　　　　　　.Range("B2").PasteSpecial Paste:=xlValues
　　　　　　.Range("A:A,D:D").ColumnWidth = 0.5
　　　　　　.Columns("B:B").ColumnWidth = 10
　　　　　　.Columns("C:C").ColumnWidth = 50
　　　　　　.Rows(1).RowHeight = 5
　　　　　　.Rows(17).RowHeight = 5
　　　　　　.Columns("E:IV").Hidden = True
　　　　　　.Rows("18:65536").Hidden = True
　　　　　　.Range("c3").Locked = True
　　　　　　.Protect password:="1234"
　　　　End With
　　　　With .Windows(1)
　　　　　　.DisplayGridlines = False
　　　　　　.DisplayHeadings = False
　　　　　　.DisplayOutline = False
　　　　　　.DisplayZeros = False
　　　　　　.DisplayHorizontalScrollBar = False
　　　　　　.DisplayVerticalScrollBar = False
　　　　　　.DisplayWorkbookTabs = False
　　　　End With
　　　　.SaveAs Filename:=ThisWorkbook.Path & "\" & InPt & "タグ.xls"
　　　　 .DisplayAlerts = False
　　　　.Close False
　　End With
　　ws.Range("C3").ClearContents
　　With Application
　　　　.EnableEvents = True
　　End With
　　Set ws = Nothing
　　MsgBox "タグ作成しました。"
【64137】Re:メニューバーの非表示について
発言  n  - 10/1/21(木) 19:33 -
引用なし
パスワード
   >InPtに入力された値をC3セルに入れ、VLOOKUP関数を使って表示し、
>表示された内容を新規ブックにコピーしていましたが
そのようなVLOOKUP関数はやめたほうが良いです。
"台帳"シートがActiveSheetなのですか？

その場合、
>If ActiveSheet.Range("$c$5:$c$3000").Find(What:=InPt, _
>　　　　　　　　　　　　　　　　　　　　　LookIn:=xlValues, _
>　　　　　　　　　　　　　　　　　　　　　lookat:=xlWhole, _
>　　　　　　　　　　　　　　　　　　　　　SearchOrder:=xlByColumns, _
>　　　　　　　　　　　　　　　　　　　　　MatchByte:=False) Is Nothing Then
ここで既に検索してないですか？

だったら、検索結果のセルをRange型変数に入れて、
その変数からのOffset位置でLoopしてセルの値を繋げばいいんじゃないですか？
'：
Dim c As Range
Dim i As Long
Dim x As String
Dim v(23 To 63)
'：
For i = 23 To 63
　　v(i) = c.Offset(, i)
Next
x = WorksheetFunction.Trim(Join(v, ""))
MsgBox x
'：
【64138】有難う御座いました。
お礼  らいち  - 10/1/21(木) 19:39 -
引用なし
パスワード
   大変分かりやすく、ご指導頂き
助かりました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3117 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free