フォルダの中に複数のExcelファイル(ブック)が入っており、
それら全てのブック・シートの保護/解除を一括して行うマクロを現在使用しています。(後述)
＜現在の利用状況＞
◆フォルダの中に複数のExcelファイル(ブック)が入っている（雛形、シート構成は全て同じ）
◆全てのブックにパスワード付きでブック保護・シート保護をかけている→パスワードは共通(1111)
◆マクロ用ブックは上記の処理対象ブックとは別フォルダに入れている
（現在のVBAでは同一フォルダ内に入れた状態では作動しない）
◆マクロを実行する都度、任意のフォルダを選択する
＜改善希望＞
◆マクロ用ブックと処理対象のブックを同一フォルダに入れた状態で作動するようにしたい
（同一フォルダ内の自ブック以外のブックに対してブック・シートの保護/解除を一括処理したい）
VBA初心者なので構文をどう書き換えるかで行き詰っています。
ThisWorkbook.Path を使うというのはなんとなく分かりますが、
何パターンか試してエラーの繰り返しです…。
ご教示頂けます様お願いいたします。
-------------------------------------------------------------------------
Sub 選択フォルダ内全て保護()
Dim myFol As Object, myFile As Object, sh As Worksheet
Dim openFilePath As String
Const myPass As String = "1111"
Set myFol = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0)
If myFol Is Nothing Then Exit Sub
Application.ScreenUpdating = False
openFilePath = myFol.self.Path & "\"
With CreateObject("Scripting.FileSystemObject")
For Each myFile In .GetFolder(openFilePath).Files
If .GetExtensionName(myFile.Path) = "xls" Then
With Application.Workbooks.Open(myFile.Path)
For Each sh In .Worksheets
sh.Protect Password:=myPass, DrawingObjects:=False, Contents:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next sh
.Protect Password:=myPass, Structure:=True, Windows:=False
.Save
.Close False
End With
End If
Next myFile
End With
MsgBox "終了しました"
End Sub
-------------------------------------------------------------------------
Sub 選択フォルダ内保護全て解除()
Dim myFol As Object, myFile As Object, sh As Worksheet
Dim openFilePath As String
Const myPass As String = "1111"
Set myFol = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0)
If myFol Is Nothing Then Exit Sub
Application.ScreenUpdating = False
openFilePath = myFol.self.Path & "\"
With CreateObject("Scripting.FileSystemObject")
For Each myFile In .GetFolder(openFilePath).Files
If .GetExtensionName(myFile.Path) = "xls" Then
With Application.Workbooks.Open(myFile.Path)
For Each sh In .Worksheets
sh.Unprotect Password:=myPass
Next sh
.Unprotect Password:=myPass
.Save
.Close False
End With
End If
Next myFile
End With
MsgBox "終了しました"
End Sub
-------------------------------------------------------------------------
マクロで特殊文字入力は出来ないのでしょうか？
やりたい内容は、セルをダブルクリックした時に✓を表示させたいのです。
セルをダブルクリックした時に○を表示するマクロが、下記の通りである時、
○の代わりに✓を表示させたいのですが、VBAで○の所に✓で書き換えると
?と表示されてしまいます。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Value = "○" Then
.Value = ""
Else
.Value = "○"
End If
End With
End Sub
現在ACCESS2003で出荷データから売上の集計が可能となるように
試みているのですが、都合上プログラムとデータを分けて処理
したいと考えております。
そこで、リンクテーブルを活用したいと思うのですが、環境に
よってパスが変更となったり、データソースを切り替えたい時
などリンクテーブルのパスが変更できると非常に有難い状況です。
多少ネットで調べVBAで変更させる方法は見つかったのですが、
基本的に１つのリンク先を想定しているとの事で、複数は対応
していないようです。
例えば、リンクテーブルをそれぞれ
TBL伝票データ → C:\DB1\A.mdb
TBL得意先マスター → C:\DB2\B.mdb
TBL商品マスター → C:\DB2\C.mdb
と言ったように複数リンク先がある場合でそれぞれ
パス変更が生じた場合に簡単に変更ができる方法は無いでしょうか。
（リンクファイルが１つの場合）
Dim db As Database
Dim a As TableDef
Set db = CurrentDb()
For Each a In db.TableDefs
If Len(a.Connect) <> 0 Then
a.Connect = ";database=" & NEWPATH '→新しいパス名
a.RefreshLink
End If
Next
db.TableDefs.Refresh
http://oshiete1.goo.ne.jp/kotaeru.php3?q=614375
で以前も教えていただいたんですが、なぜかできなくて…。
Sub Hensuu()
For i = 1 To 5
Gyou(i) = i * i
MsgBox Gyou(i)
Next i
End Sub
と試しにしてみたんですが、
「コンパイルエラー：
Sub または Function が定義されていません。」
と出てしまいました。
どこがいけないのでしょうか？
Excel97,Windows98SEを使用しています。
シート上に作成したコントロールツールのコマンドボタンをクリックすると、
シート上の全ての図形を選択して、順序を最背面にするというマクロを作成したのですが、
選択した図形のハンドルが消えません。
図形選択を解除して、B26セルを選択したいのですが、どうしたらよいでしょうか？
Private Sub CButton_gyou_Click()
ActiveSheet.DrawingObjects.Select
Selection.ShapeRange.ZOrder msoSendToBack
Range("B26").Select
End Sub
ご存知の方、どうぞよろしくお願いいたします。
