お世話になります。
ExcelVBAで、コマンドバーの類を全て消去した後に残る、
空白部分ができる原因が解りません。
この部分をダブルクリックすると、エラーになって強制終了に
なってしまいます。
完全に消してしまいたいのですが、この状況になってしまう、
原因と対策を教えてください。
内容は、『システム』という名のシートにある『ロック』ボタンを
押すと、コマンドバーを全て消去して、Sheet1に切り替わるといった
流れです。
↓モジュール側
-------------------------------------------------------------
Dim myCB As CommandBar
Public Sub onCmdBarAttr()
DoEvents
With Application
For Each myCB In Application.CommandBars
myCB.Enabled = True
Next myCB
.CommandBars("Standard").Visible = True
.CommandBars("Formatting").Visible = True
.CommandBars("Visual Basic").Visible = True
.CommandBars("Worksheet Menu Bar").Enabled = True
.CommandBars("CELL").Enabled = True
' タスクバーに表示させる
.ShowWindowsInTaskbar = True
' 数式バーを表示
.DisplayFormulaBar = True
' ステータスバーを表示
.DisplayStatusBar = True
End With
End Sub
Public Sub offCmdBarAttr()
Dim myCB As CommandBar
On Error Resume Next
For Each myCB In Application.CommandBars
myCB.Enabled = False
Next myCB
On Error GoTo 0
With Application
.CommandBars("Worksheet Menu Bar").Enabled = False
.CommandBars("CELL").Enabled = False
' 数式バーを消去
.DisplayFormulaBar = False
' ステータスバーを消去
.DisplayStatusBar = False
' タスクバーに表示させない
.ShowWindowsInTaskbar = False
End With
End Sub
' シートロック
Public Sub protectSheet(ByVal stSheetName As String)
Application.ScreenUpdating = False
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Activate
.Unprotect
.Protect UserInterfaceOnly:=True
' カーソルの移動範囲を設定する
.ScrollArea = "$A$1"
' 左上セルを選択
.Range("H16").Select
' 保護されたセルは選択不可にする
.EnableSelection = xlNoRestrictions
End With
Application.ScreenUpdating = True
End Sub
' シートロック解除
Public Sub unprotectSheet(ByVal stSheetName As String)
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Unprotect
' スクロール範囲を解除する
.ScrollArea = ""
' 保護されたセルでも選択可能にする
.EnableSelection = xlUnlockedCells
End With
End Sub
Public Sub setBookAttribute(ByVal bFlg As Boolean)
With Windows(ThisWorkbook.Name)
' タブを設定
.DisplayWorkbookTabs = bFlg
' スクロールバーを設定
.DisplayHorizontalScrollBar = bFlg
.DisplayVerticalScrollBar = bFlg
' グリッドを設定
.DisplayGridlines = bFlg
' 行列数表示を設定
.DisplayHeadings = bFlg
End With
End Sub
↓シート側
------------------------------------------------------
Private Sub btnProtect_Click()
' アプリケーション全体の処理
Call Module1.offCmdBarAttr
' シート単位の処理
Call Module1.protectSheet("Sheet1")
' ブック単位の処理
Call setBookAttribute(False)
Worksheets("Sheet1").Activate
End Sub
Private Sub btnUnprotect_Click()
Call Module1.onCmdBarAttr
Call Module1.unprotectSheet("Sheet1")
Call setBookAttribute(True)
End Sub
以上、よろしくお願いいたします。
お世話になります。
ExcelVBAで、コマンドバーの類を全て消去した後に残る、
空白部分ができる原因が解りません。
この部分をダブルクリックすると、エラーになって強制終了に
なってしまいます。
完全に消してしまいたいのですが、この状況になってしまう、
原因と対策を教えてください。
内容は、『システム』という名のシートにある『ロック』ボタンを
押すと、コマンドバーを全て消去して、Sheet1に切り替わるといった
流れです。
↓モジュール側
-------------------------------------------------------------
Dim myCB As CommandBar
Public Sub onCmdBarAttr()
DoEvents
With Application
For Each myCB In Application.CommandBars
myCB.Enabled = True
Next myCB
.CommandBars("Standard").Visible = True
.CommandBars("Formatting").Visible = True
.CommandBars("Visual Basic").Visible = True
.CommandBars("Worksheet Menu Bar").Enabled = True
.CommandBars("CELL").Enabled = True
' タスクバーに表示させる
.ShowWindowsInTaskbar = True
' 数式バーを表示
.DisplayFormulaBar = True
' ステータスバーを表示
.DisplayStatusBar = True
End With
End Sub
Public Sub offCmdBarAttr()
Dim myCB As CommandBar
On Error Resume Next
For Each myCB In Application.CommandBars
myCB.Enabled = False
Next myCB
On Error GoTo 0
With Application
.CommandBars("Worksheet Menu Bar").Enabled = False
.CommandBars("CELL").Enabled = False
' 数式バーを消去
.DisplayFormulaBar = False
' ステータスバーを消去
.DisplayStatusBar = False
' タスクバーに表示させない
.ShowWindowsInTaskbar = False
End With
End Sub
' シートロック
Public Sub protectSheet(ByVal stSheetName As String)
Application.ScreenUpdating = False
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Activate
.Unprotect
.Protect UserInterfaceOnly:=True
' カーソルの移動範囲を設定する
.ScrollArea = "$A$1"
' 左上セルを選択
.Range("H16").Select
' 保護されたセルは選択不可にする
.EnableSelection = xlNoRestrictions
End With
Application.ScreenUpdating = True
End Sub
' シートロック解除
Public Sub unprotectSheet(ByVal stSheetName As String)
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Unprotect
' スクロール範囲を解除する
.ScrollArea = ""
' 保護されたセルでも選択可能にする
.EnableSelection = xlUnlockedCells
End With
End Sub
Public Sub setBookAttribute(ByVal bFlg As Boolean)
With Windows(ThisWorkbook.Name)
' タブを設定
.DisplayWorkbookTabs = bFlg
' スクロールバーを設定
.DisplayHorizontalScrollBar = bFlg
.DisplayVerticalScrollBar = bFlg
' グリッドを設定
.DisplayGridlines = bFlg
' 行列数表示を設定
.DisplayHeadings = bFlg
End With
End Sub
↓シート側
------------------------------------------------------
Private Sub btnProtect_Click()
' アプリケーション全体の処理
Call Module1.offCmdBarAttr
' シート単位の処理
Call Module1.protectSheet("Sheet1")
' ブック単位の処理
Call setBookAttribute(False)
Worksheets("Sheet1").Activate
End Sub
Private Sub btnUnprotect_Click()
Call Module1.onCmdBarAttr
Call Module1.unprotectSheet("Sheet1")
Call setBookAttribute(True)
End Sub
以上、よろしくお願いいたします。
お世話になります。
ExcelVBAで、コマンドバーの類を全て消去した後に残る、
空白部分ができる原因が解りません。
この部分をダブルクリックすると、エラーになって強制終了に
なってしまいます。
完全に消してしまいたいのですが、この状況になってしまう、
原因と対策を教えてください。
内容は、『システム』という名のシートにある『ロック』ボタンを
押すと、コマンドバーを全て消去して、Sheet1に切り替わるといった
流れです。
↓モジュール側
-------------------------------------------------------------
Dim myCB As CommandBar
Public Sub onCmdBarAttr()
DoEvents
With Application
For Each myCB In Application.CommandBars
myCB.Enabled = True
Next myCB
.CommandBars("Standard").Visible = True
.CommandBars("Formatting").Visible = True
.CommandBars("Visual Basic").Visible = True
.CommandBars("Worksheet Menu Bar").Enabled = True
.CommandBars("CELL").Enabled = True
' タスクバーに表示させる
.ShowWindowsInTaskbar = True
' 数式バーを表示
.DisplayFormulaBar = True
' ステータスバーを表示
.DisplayStatusBar = True
End With
End Sub
Public Sub offCmdBarAttr()
Dim myCB As CommandBar
On Error Resume Next
For Each myCB In Application.CommandBars
myCB.Enabled = False
Next myCB
On Error GoTo 0
With Application
.CommandBars("Worksheet Menu Bar").Enabled = False
.CommandBars("CELL").Enabled = False
' 数式バーを消去
.DisplayFormulaBar = False
' ステータスバーを消去
.DisplayStatusBar = False
' タスクバーに表示させない
.ShowWindowsInTaskbar = False
End With
End Sub
' シートロック
Public Sub protectSheet(ByVal stSheetName As String)
Application.ScreenUpdating = False
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Activate
.Unprotect
.Protect UserInterfaceOnly:=True
' カーソルの移動範囲を設定する
.ScrollArea = "$A$1"
' 左上セルを選択
.Range("H16").Select
' 保護されたセルは選択不可にする
.EnableSelection = xlNoRestrictions
End With
Application.ScreenUpdating = True
End Sub
' シートロック解除
Public Sub unprotectSheet(ByVal stSheetName As String)
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Unprotect
' スクロール範囲を解除する
.ScrollArea = ""
' 保護されたセルでも選択可能にする
.EnableSelection = xlUnlockedCells
End With
End Sub
Public Sub setBookAttribute(ByVal bFlg As Boolean)
With Windows(ThisWorkbook.Name)
' タブを設定
.DisplayWorkbookTabs = bFlg
' スクロールバーを設定
.DisplayHorizontalScrollBar = bFlg
.DisplayVerticalScrollBar = bFlg
' グリッドを設定
.DisplayGridlines = bFlg
' 行列数表示を設定
.DisplayHeadings = bFlg
End With
End Sub
↓シート側
------------------------------------------------------
Private Sub btnProtect_Click()
' アプリケーション全体の処理
Call Module1.offCmdBarAttr
' シート単位の処理
Call Module1.protectSheet("Sheet1")
' ブック単位の処理
Call setBookAttribute(False)
Worksheets("Sheet1").Activate
End Sub
Private Sub btnUnprotect_Click()
Call Module1.onCmdBarAttr
Call Module1.unprotectSheet("Sheet1")
Call setBookAttribute(True)
End Sub
以上、よろしくお願いいたします。
お世話になります。
ExcelVBAで、コマンドバーの類を全て消去した後に残る、
空白部分ができる原因が解りません。
この部分をダブルクリックすると、エラーになって強制終了に
なってしまいます。
完全に消してしまいたいのですが、この状況になってしまう、
原因と対策を教えてください。
内容は、『システム』という名のシートにある『ロック』ボタンを
押すと、コマンドバーを全て消去して、Sheet1に切り替わるといった
流れです。
↓モジュール側
-------------------------------------------------------------
Dim myCB As CommandBar
Public Sub onCmdBarAttr()
DoEvents
With Application
For Each myCB In Application.CommandBars
myCB.Enabled = True
Next myCB
.CommandBars("Standard").Visible = True
.CommandBars("Formatting").Visible = True
.CommandBars("Visual Basic").Visible = True
.CommandBars("Worksheet Menu Bar").Enabled = True
.CommandBars("CELL").Enabled = True
' タスクバーに表示させる
.ShowWindowsInTaskbar = True
' 数式バーを表示
.DisplayFormulaBar = True
' ステータスバーを表示
.DisplayStatusBar = True
End With
End Sub
Public Sub offCmdBarAttr()
Dim myCB As CommandBar
On Error Resume Next
For Each myCB In Application.CommandBars
myCB.Enabled = False
Next myCB
On Error GoTo 0
With Application
.CommandBars("Worksheet Menu Bar").Enabled = False
.CommandBars("CELL").Enabled = False
' 数式バーを消去
.DisplayFormulaBar = False
' ステータスバーを消去
.DisplayStatusBar = False
' タスクバーに表示させない
.ShowWindowsInTaskbar = False
End With
End Sub
' シートロック
Public Sub protectSheet(ByVal stSheetName As String)
Application.ScreenUpdating = False
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Activate
.Unprotect
.Protect UserInterfaceOnly:=True
' カーソルの移動範囲を設定する
.ScrollArea = "$A$1"
' 左上セルを選択
.Range("H16").Select
' 保護されたセルは選択不可にする
.EnableSelection = xlNoRestrictions
End With
Application.ScreenUpdating = True
End Sub
' シートロック解除
Public Sub unprotectSheet(ByVal stSheetName As String)
' 一旦シート保護をかけ直す
With Worksheets(stSheetName)
.Unprotect
' スクロール範囲を解除する
.ScrollArea = ""
' 保護されたセルでも選択可能にする
.EnableSelection = xlUnlockedCells
End With
End Sub
Public Sub setBookAttribute(ByVal bFlg As Boolean)
With Windows(ThisWorkbook.Name)
' タブを設定
.DisplayWorkbookTabs = bFlg
' スクロールバーを設定
.DisplayHorizontalScrollBar = bFlg
.DisplayVerticalScrollBar = bFlg
' グリッドを設定
.DisplayGridlines = bFlg
' 行列数表示を設定
.DisplayHeadings = bFlg
End With
End Sub
↓シート側
------------------------------------------------------
Private Sub btnProtect_Click()
' アプリケーション全体の処理
Call Module1.offCmdBarAttr
' シート単位の処理
Call Module1.protectSheet("Sheet1")
' ブック単位の処理
Call setBookAttribute(False)
Worksheets("Sheet1").Activate
End Sub
Private Sub btnUnprotect_Click()
Call Module1.onCmdBarAttr
Call Module1.unprotectSheet("Sheet1")
Call setBookAttribute(True)
End Sub
以上、よろしくお願いいたします。
Excelのマクロについてです。プログラミングなんていう大層なカテゴリではないのですが・・・
複数枚あるシート（枚数はランダム）で、左端のSheet1に検索キーワードが入っています。
右側のシート群には上記キーワードがちりばめられており、これらを視覚的に目立たせるマクロを考えています。
つまりSheet1のある範囲(具体的にはE6以下、データが存在する位置までの範囲)に並んだ文字を左のシート群で検索し、引っかかったセルに色をつけたいのですが、下記のマクロでは開始位置(E6)のセルしか見てくれません。
また、検索結果として赤くしたいのはSheet2以降の対象セルなのですが、どうしてもSheet1のセルも赤くなってしまいます。
つまり下記VBAを実行すると、Sheet1.E6の「りんご」の文字を使ってすべてのシートを検索し、Sheet1を含むすべてのシートで「りんご」の文字が入ったセルが赤くなります。
ループを仕込んでいるにもかかわらず「みかん」の文字は赤くなりません。
どこでポカをやっているのでしょうか？
シート関数でしたらそれなりに使えるのですがマクロはなかなか理解しづらく・・・
なにとぞヒントをいただけませんか？
＜状況＞
最初のシートはE6より縦に
E6 りんご
E7 みかん
・
・
・
と並び、右のシート（数枚）に、ランダムにその文字が入力されています。書式はバラバラです。
＜目標＞
最初のシートのある範囲（E6以下）にある文字がSheet2以降で見つかった場合、そのセルを赤く、文字を白くしたい。
以下は自分で作ってみたへぼへぼマクロです：
Sub セルに色付け()
Dim SearchCount As Integer
Dim SearchLineID
Dim WS As Worksheet
Set WS = ActiveSheet '後で現在のSheetに戻ってくるため
SearchCount = Range("E6").CurrentRegion.Rows.Count 'E6から下に読んでいこうとしています
For i = 1 To SearchCount
SearchLineID = Cells(i + 5, 5).Value 'E6から始めるための補正です
For n = 2 To Sheets.Count 'シートの数を取得し、2枚目から検索を行う意図です
With Application.ReplaceFormat.Font
.Subscript = False
.ColorIndex = 2
End With
Application.ReplaceFormat.Interior.ColorIndex = 3
Sheets(n).Select
Range("A6:AF512").Select 'とりあえずこの範囲を検索
Selection.Replace What:=SearchLineID, Replacement:=SearchLineID, LookAt:= _
xlWhole, SearchOrder:=xlByRows, ReplaceFormat:=True
Next n
Next i
WS.Activate
End Sub
2009.12.21～2010.1.20と入力された場合、結果2
2009.4.1～2009.4.30と入力された場合、結果1
のように対象となる（足かけ月数）月数を出す方法を知りたいのです。
下記コードのように変数Ａ、ＢにVariant型で入力してもらい（Variant型でないと困る理由があるので）
それをDate型に変換したり、またVariant型に戻したり（必要があり）しながら、myOpenFileNamesにMypath & MyFileを順次追加すべく進めたいのですが、Mcntを出せずにいます。
Month(B)-Month(A)では12月と1月で不具合が出るし‥
期間が3か月以上の場合もあります。
なにかシンプルなのがありそうなので半日調べたのですが解りませんでした。皆様、お助け下さいませ。
ここまで省略
'●請求対象期間の入力
A = Application.InputBox("請求対象期間（開始日）を入力してください。", "開始日", "2009.12.21", Type:=2)
If A = False Then
MsgBox " Cancel ボタンが押されました"
Exit Sub
End If
On Error GoTo OWARI3
A = CDate(Replace(A, ".", "/"))
On Error GoTo 0
B = Application.InputBox("請求対象期間（締め日）を入力してください。", "締め日", Replace(Format(DateAdd("d", -1, DateAdd("m", 1, A)), "yyyy/mm/dd"), "/", "."), Type:=2)
If B = False Then
GoTo OWARI
End If
On Error GoTo OWARI3
B = CDate(Replace(B, ".", "/"))
On Error GoTo 0
If A > B Then
MsgBox A & "～" & B & " は請求日と締め日が逆転してます。", vbOKOnly + vbCritical, "最初からやり直して下さい。"
GoTo OWARI
End If
D = B - A
msgRec = MsgBox(A & "～" & B & "分でよろしいですか？", vbOKCancel + vbQuestion, "対象は" & D + 1 & "日分です")
If msgRec = vbCancel Then
MsgBox " Cancel ボタンが押されました"
Exit Sub
End If
Mcnt = ●○○○● ←ここを出す方法を知りたいのです。********************************
ReDim BN(1 To Mcnt)
For i = 1 To Mcnt
BN(i) = Replace(Format(DateAdd("m", i - 1, A), "yyyy/mm"), "/", ".")
Mypath = ThisWorkbook.Path & "\明細書一覧" & BN(i) & "月"
MyFile = "\明細書一覧" & BN(i) & "月.xls"
myOpenFileNames.Add (Mypath & MyFile)
Next i
以下略
2009.12.21～2010.1.20と入力された場合、結果2
2009.4.1～2009.4.30と入力された場合、結果1
のように対象となる（足かけ月数）月数を出す方法を知りたいのです。
下記コードのように変数Ａ、ＢにVariant型で入力してもらい（Variant型でないと困る理由があるので）
それをDate型に変換したり、またVariant型に戻したり（必要があり）しながら、myOpenFileNamesにMypath & MyFileを順次追加すべく進めたいのですが、Mcntを出せずにいます。
Month(B)-Month(A)では12月と1月で不具合が出るし‥
期間が3か月以上の場合もあります。
なにかシンプルなのがありそうなので半日調べたのですが解りませんでした。皆様、お助け下さいませ。
ここまで省略
'●請求対象期間の入力
A = Application.InputBox("請求対象期間（開始日）を入力してください。", "開始日", "2009.12.21", Type:=2)
If A = False Then
MsgBox " Cancel ボタンが押されました"
Exit Sub
End If
On Error GoTo OWARI3
A = CDate(Replace(A, ".", "/"))
On Error GoTo 0
B = Application.InputBox("請求対象期間（締め日）を入力してください。", "締め日", Replace(Format(DateAdd("d", -1, DateAdd("m", 1, A)), "yyyy/mm/dd"), "/", "."), Type:=2)
If B = False Then
GoTo OWARI
End If
On Error GoTo OWARI3
B = CDate(Replace(B, ".", "/"))
On Error GoTo 0
If A > B Then
MsgBox A & "～" & B & " は請求日と締め日が逆転してます。", vbOKOnly + vbCritical, "最初からやり直して下さい。"
GoTo OWARI
End If
D = B - A
msgRec = MsgBox(A & "～" & B & "分でよろしいですか？", vbOKCancel + vbQuestion, "対象は" & D + 1 & "日分です")
If msgRec = vbCancel Then
MsgBox " Cancel ボタンが押されました"
Exit Sub
End If
Mcnt = ●○○○● ←ここを出す方法を知りたいのです。********************************
ReDim BN(1 To Mcnt)
For i = 1 To Mcnt
BN(i) = Replace(Format(DateAdd("m", i - 1, A), "yyyy/mm"), "/", ".")
Mypath = ThisWorkbook.Path & "\明細書一覧" & BN(i) & "月"
MyFile = "\明細書一覧" & BN(i) & "月.xls"
myOpenFileNames.Add (Mypath & MyFile)
Next i
以下略
すみませんがご教示いただければ幸いです。
セル範囲を選択させ、情報を得てから作業するのですが、コードにたくさんSelection（すべて同じ選択範囲）が出てくるのでWith～End Withでまとめようと思いました。
ところが、まとめてもSelectionという表記を省略できたのはほんのわずかです。
ご覧の通り、TypeName(Selection) をはじめIntersect(Selection(1), 等々省略できないのがほとんどです。
Set myRng=Selection でやったとしても、SelectionがｍｙRngに変わるだけでぜんぜん省略にならないですよね？
こんな場合は何か別の省略した書き方があるのでしょうか？
Sub test()
With Selection
If TypeName(Selection) <> "Range" Then 'セル以外をセレクトしてたら
MsgBox "セル範囲を選択してください。", vbCritical, " Σ（￣ロ￣lll)"
Exit Sub
End If
If Intersect(Selection(1), Range("D4:AY65")) Is Nothing _
Or Intersect(Selection(.Count), Range("D4:AY65")) Is Nothing Then '指定のセル範囲をはみ出てたら
ans = MsgBox("はみ出してますがいいんですか？", vbYesNo + vbQuestion, " （￣□￣; ？ ")
If ans = vbNo Then
Exit Sub
End If
End If
For Each Ln In ActiveSheet.Lines '配置された各直線につき
If Not Intersect(Range(Ln.TopLeftCell, Ln.BottomRightCell.Offset(0, -1)), Selection) Is Nothing Then '選択範囲とかぶってたら
MsgBox "重複してます！", vbCritical, " （￣□￣；）！！ "
Exit Sub
End If
Next
End With
'以下、無関係なので略します。
End Sub
