Excel VBA質問箱 IV

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

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


18143 / 76732 ←次へ | 前へ→

【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プロパティでの制御をおすすめします。
>
>#手作業でもコピー可能にしたい場合は、ひと工夫必要です。

0 hits

【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 お礼

18143 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free