【再掲載&追加情報です】
ずっとwindowsXP SP3を使用していたのですが(Excel2002 SP3もそのまま)
今回急遽社内のパソコンが2台(1台は自分のです)だけWindows7に変わりました。
その2台だけExcelも2002から2010に変わったのですが、使用しているファイルで記述してる
FileSearchが使えないとあとから知りました。(泣)
ネットで検索してFileSystemObjectを代わりに使用するというのを知りましたが
初心者の為理解が難しく・・・。
申し訳ありませんが記述の変更方法を教えていただけないでしょうか?
(1)フォルダーは ”C:\指示\記入済” に出来たExcelファイルを保存してます
(2)番号は指定フォルダ内のエクセルファイルをカウントしてその数+1を
U1のセルに表示させています。
(3)作成した保存ボタンで新見積書を保存する
但し、マクロコードとボタンを削除したものを保存する
(4)新見積書の保存後はブック、エクセルともに終了する
**************現在使用中データ**************
--- Module1 ----
Public Const FPath = "C:\指示\記入済"
'xlsファイル検索
Sub Auto_Open()
With Application.FileSearch
.NewSearch
.Filename = "*.xls"
.FileType = msoFileTypeAllFiles
.LookIn = FPath
.SearchSubFolders = False
.Execute
Cells(1, 21).Value = .FoundFiles.Count + 1
Cells(1, 21).NumberFormat = "0000"
End With
End Sub
--- Module2 ----
Sub ファイルに名前を付けて保存()
Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = FPath & "\" & Range("T1") & Format(Range("U1"), "0000") & Range("B1") & ".xls"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)
If 保存ファイル名 = False Then
MsgBox "保存は中止されました"
Exit Sub
End If
ActiveWorkbook.SaveCopyAs 保存ファイル名
Dim NewBook As Workbook
Set NewBook = Workbooks.Open(保存ファイル名)
Dim myVBA As Object
For Each myVBA In NewBook.VBProject.VBComponents
With myVBA
If .Type = 100 Then
.CodeModule.DeleteLines 1, .CodeModule.CountOfLines
Else
Application.VBE.activeVBProject.VBComponents.Remove myVBA
End If
End With
Next myVBA
NewBook.ActiveSheet.Shapes(1).Delete
NewBook.Close True
'●●●
Set NewBook = Workbooks.Open(保存ファイル名)
NewBook.Close True
'●●●
'ブックとエクセル終了
Application.Quit
ThisWorkbook.Close False
End Sub
********************************************
上記がExcel2002で問題なく動いている記述です。
最初Excel2010で起動してエラーが出たので検索したとき、てっきりFileSearchだけが問題
だと思っていたのですがもしかして他にもあったのでしょうか?
--- Module1 ----は、先ほど質問したときに
Public Const FPath = "C:\指示\記入済"
'xlsファイル検索
Sub Auto_Open()
Dim tmp as String
Dim i as Long
tmp = Dir(FPath & "¥*.xls")
Do While tmp <> ""
i = i + 1
tmp = Dir()
Loop
Cells(1, 21).Value = i+1
Cells(1, 21).NumberFormat = "0000"
End Sub
に変更したら動くようになりました。
ただ、作成した保存ボタンを押すと指定した場所に指定したセルの文字を拾って
ファイル名を表示させるまでマクロに登録(Module2)したのですが、
指定したフォルダは開いてるのですがファイル名が空欄のままです。
更にそれに手打ちでファイル名を打ち、保存すると
実行時エラー1004
プログラミングによるVisualBasicプロジェクトへのアクセスは信頼性に欠けます
と表示されます・・・。
デバックを押すと
For Each myVBA In NewBook.VBProject.VBComponents
の部分が黄色くなってました><
他に情報としては
このファイルはxlt(テンプレート)にしています。
使用者たちにはファイル名を打たせないように上記のようにしました。
再度宜しくお願いします・・・。
何度もお手数をおかけしまして申し訳ありません。。。
No.1ベストアンサー
- 回答日時:
ひとつ目「保存ファイル名の欄が空欄のまま」については、自信がないのですが、モジュール2の
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名)
の行を、
保存ファイル名 = Application.GetSaveAsFilename(InitialFileName:= 既定ファイル名)
としてみてください。
ふたつ目、「プログラミングによる Visual Basic プロジェクトへのアクセスは信頼性に欠けます」については、エクセル2010自体のセキュリティの設定の問題だと思います。下記の設定をしてみてください。
「ファイル」タブを選択
画面左の「オプション」を選択
ダイアログ左の「セキュリティ センター」を選択
ダイアログ右の「セキュリティ センターの設定」ボタンを選択
ダイアログ左の「マクロの設定」 を選択
ダイアログ右の「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」のチェックボックスにチェックを入れる
お礼遅くなってすみません。(昨日は休みだったもので・・・)
やってみましたら無事動きました!
ありがとうございます><
最後エラーが出ましたが原因はシート保護によるもので、
ファイル名を拾う部分のセルをロック解除してシート保護をしたら
そのエラーもなくなり無事うごきました!
ありがとうございましたっ!!
No.2
- 回答日時:
こんにちは。
お邪魔します。ご提示の Sub ファイルに名前を付けて保存()、についてですが、
処理の内容としては、アクティブブックのコピーを取ってから、
VBAの記述と追加されているモジュールとシート上のShapeを削除する、
というものになっています。
わざわざVBIDE操作をする必要はないと思いますが、
VBAの記述を操作する、ということは、プログラムを書き換える、ということを意味します。
Excelを含む大抵のアプリケーションにおいて、容易に書換えが出来ない様に
保護する仕組みが予め用意してあります。
Excel VBAからVBAの内容を取得したり書き換えたりするには
セキュリティレベルを大甘にして、
PCに紛れ込んでいるかも知れない善からぬプログラムに対しても無抵抗な状態
に設定を変更する必要があります。
ただ、セキュリティというのは、部分的に評価できるものではありませんから、
そうした無防備な状態であっても問題ないであろう環境もあろうかとは思います。
とはいえ、プログラムを書き換える、という意味においては、
決して他人に薦められるようなものではありませんし、
職場でそのようなプログラムを許可してもいいものか(私周辺では軒並み厳禁ですが)、
という議論も当然あることでしょう。
私個人としては、そういったコードは
他に方法がない非常に特殊な場合の、私的な用途に限って扱われるべきもの
と考えています。
まぁでも人それぞれ事情はおありでしょうから、考えを押し付けるつもりもありません。
ただ、現実的な問題として、個々のPC環境について、
Excelのセキュリティ設定を変更しないと機能しない、というのでは、
ちょっと扱い難い、というか、できれば避けたい、のではないでしょうか。
以上のような考えを元に、平易な方法でも実現できることを
提案してみようと思います。
新規のブックを追加(予めシート数を合わせておく)
元となるブックのすべてのワークシートをループして
元となる各シートのセル範囲をコピーしたものを
新規ブックの対応するシートのセル範囲に貼り付ける
(シェープはコピーしない)
元となるブックのアクティブシートに対応する
シートを新規ブック側でアクティブにする
保存ファイル名を指定して.Save (閉じる?)
Excelを終了
というような処理内容です。
処理は少し増えますが、セキュリティ設定を変更する必要はありません。
> 但し、マクロコードとボタンを削除したものを保存する
VBA(マクロ)とシェープ(ボタン)以外をコピーする、という風に解釈替えをしています。
(例外的に、グラフシートについては今回は無いものとして書いています。
あるならあるで、少し書き加えれば対応出来ますけれど)
Application.GetSaveAsFilename の扱いは正しました。
> 実行時エラー1004
> プログラミングによるVisualBasicプロジェクトへのアクセスは信頼性に欠けます
このエラーは起こりようがないように書きました。
xl2010では動作確認していますが、旧バージョンは未確認です。
何か問題があれば補足してみてください。
もしエラーが出る場合は、呼び出し元のボタンが、
フォームコントロールなのか、ActiveXコントロールなのか、によっても
対処が変わる場合があります。
なんだかんだ、標準的な、ベタな、処理しかしていませんが、
よりメンテし易い、質問した時にも答えられる人の多い、内容にはなっていると思います。
尚、Sub Auto_Open()、についてはこちらからは触れません。既に解決済と考えています。
' ' --- Module2 ----
Sub ファイルに名前を付けて保存()
Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = FPath & "\" & Range("T1") & Format(Range("U1"), "0000") & Range("B1") & ".xls"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excelファイル,*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました"
Exit Sub
End If
Dim NewBook As Workbook
Dim oWsht As Worksheet
Dim nShtInNew As Long
Dim bCopyObj As Boolean
Dim i As Long
With ActiveWorkbook
nShtInNew = Application.SheetsInNewWorkbook ' ●シート数
Application.SheetsInNewWorkbook = .Worksheets.Count ' ●シート数
Set NewBook = Workbooks.Add ' 新規ブック
Application.SheetsInNewWorkbook = nShtInNew ' ●シート数
bCopyObj = Application.CopyObjectsWithCells ' ●コピー_オブジェクト?
Application.CopyObjectsWithCells = False ' ●コピー_オブジェクト?
For Each oWsht In .Worksheets
i = i + 1
oWsht.Cells.Copy NewBook.Worksheets(i).Cells(1) ' シートからシート、セル範囲をコピペ
Next
Application.CopyObjectsWithCells = bCopyObj ' ●コピー_オブジェクト?
NewBook.Sheets(.ActiveSheet.Index).Activate
End With
Application.DisplayAlerts = False
NewBook.SaveAs 保存ファイル名, xlExcel8 ' 新規に作成したブックを保存ファイル名で保存
Application.DisplayAlerts = True
' MsgBox "保存しました"
NewBook.Close
' ' ブックとエクセル終了
Application.Quit
End Sub
マクロでマクロを消す行為は・・・以前このデータを作ったときにも
言われました><
マクロとボタン以外をコピーするという発想!思いつきませんでした!
セキュリティを変えないですむというのはいいですねっ。
現在のファイルは回答No.1で教えていただいた方法で無事動くようになったので現状は無事仕事が進みますが、
この先を考えてこちらのコードも試してみたいと思います。
現在のシートは3シートに分かれていて(複写状態になっています【=シート1!S5】のように)
ファイル名はシート1から拾うようにしている。
シート2、シート3はシート1で従業員が書いた部分が表示されるようにしています。
ボタンもシート1にあるだけです。
まずは書いていただいたものであとで試してみようと思います^^
ありがとうございましたっ!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロ VBA ファイル名を連番...
-
エクセルでVBAを使用して1分毎...
-
excelでhtmlでの保存を元に戻...
-
開いてるファイル(エクセル等)...
-
エクセルを開いた時に強制的に...
-
エクセル・マクロ(VBA)で、指定...
-
Excelで指定範囲だけを(.prn)保...
-
マクロでエクセルをメール送信...
-
行と列を固定して表示するには
-
エクセル文書を保存したらメモ...
-
メール添付されているファイル...
-
Excelの保存について質問です。...
-
エクセルでCSVファイルとして保...
-
いきなりPDFでPDFファイルを開...
-
エクセル 更新していないのに...
-
Excel画面の自動更新 Excelファ...
-
「上書き保存確認ダイアログ」...
-
ExcelのVBAでブックの保存
-
「上書き保存」で一度警告を出...
-
ピボットテーブルの更新ができない
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
いきなりPDFでPDFファイルを開...
-
エクセルを上書き保存したのに...
-
エクセル文書を保存したらメモ...
-
エクセルでVBAを使用して1分毎...
-
Excel画面の自動更新 Excelファ...
-
メール添付されているファイル...
-
ピボットテーブルの更新ができない
-
マクロ VBA ファイル名を連番...
-
エクセル・マクロ(VBA)で、指定...
-
エクセルでCSVファイルとして保...
-
Illustratorファイルに読み取り...
-
マクロVBA特定フォルダーに次々...
-
エクセルの共有ファイルで、保...
-
エクセルがwindows終了時に未保...
-
開いてるファイル(エクセル等)...
-
エクセル表のCSV化ができない
-
エクセル 更新していないのに...
-
メールソフト「サンダーバード...
-
「変更を保存しますか?」と聞...
-
エクセルでセル値をファイル名...
おすすめ情報