| |
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プロパティでの制御をおすすめします。
>
>#手作業でもコピー可能にしたい場合は、ひと工夫必要です。
|
|
らいち
- 10/1/11(月) 9:25 -
