• 締切済み

Document.SaveAsを実行しても保存されません

VB6.0、Word2000で動作していたソースが、Word2007だと結果を保存しなくなりました。参照設定は、MicrosoftWord12.0ObjectLibraryに変更しました。 ためしに、 Public m_WordApp As Object Public m_WordDoc As Word.Document Set m_WordApp = CreateObject("Word.Application") ・・・・ ワードに出力するデータを作成。 ・・・・ m_WordDoc.Fields.Update m_WordApp.PrintPreview = True m_WordDoc.SaveAs strFileName, wdFormatDocument →出力されない。 上記のSaveAsの代わりに m_WordApp.PrintOut Background:=False m_WordDoc.Close SaveChanges:=False を実行した場合は、印刷できました。 何か設定が必要なのでしょうか。よろしくお願いいたします。

みんなの回答

回答No.1

回答がつかないですね。 もしエラー トラップをしているなら外してみてはどうでしょうか? 何かエラーが出ている可能性もあります。

hamstar1
質問者

お礼

temtecomai2さん、ありがとうございます。 エラーが発生していたわけではなく、 Public m_WordDoc As Word.Document ↓ Public m_WordDoc As object とすれば正常に動作しました。 一応報告まで。

関連するQ&A

  • EXCEL VBAでプリンタの設定方法について

    EXCEL VBAのプリンタの設定方法について質問があります。 Dim oApp As Object Dim WFM As Strin WFM = "\\Cl111\フォルダ\ファイル\" &Range("C3").Value & ".doc" Set oApp = CreateObject("Word.Application")  ’ワード起動 oApp.Visible = True oApp.Documents.Open WFM  ’文書を開く Application.ActivePrinter = "AAA on Ne00:"  ’プリンタ設定 oApp.activedocument.PrintOut Copies:=1, Background:=False  ’印刷 oApp.Quit SaveChanges:=False  ’ワード終了 Set oApp = Nothing このようなコードで、(1)ワードを開き、(2)プリンタを設定し、(3)印刷をする、という作業をしたいのですが、 Application.ActivePrinter = "AAA on Ne00:" ではプリンタの設定が変わらず、通常使うプリンターで印刷がされてしまいます。 ワードを開いて印刷することで何か特殊なコードが必要なのではないかと思うのですが、調べても該当するものが出てきませんでした。 どうぞよろしくお願いいたします。

  • 【VB】【エクセル操作】 SaveAsでエラーが出てしまいます。

    VB6.0で作成したソフトの一部でエクセルを操作する箇所があります。 『新しいブックを作成して名前を付けて保存する』ところでエラーが出てしまいます。 Excel2007,2003では正常に動作するのですが、2000ではエラーが発生し強制終了されてしまいます。 '//////////////////////////////////////////////////////////// Private Sub EditExcelFile(FileName As String) Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add xlApp.Visible = True With xlBook .Application.DisplayAlerts = False .SaveAs (FileName) .Application.DisplayAlerts = True End With Set xlBook = Nothing Set xlApp = Nothing End Function '//////////////////////////////////////////////////////////// 上記コードの .SaveAs (FileName)の箇所でエラーがでます。 .SaveAs (FileName)をコメント文にすると2000でも正常に動作します。 FileNameは新しいブック名のパスが入ります。 2000でも正常に動作させるにはどのような処理を加えれば良いでしょうか? 宜しくお願い致します。

  • 同じフォルダーに保存したい。

    報告書.xlsを一部加工後に実行するVBマクロで教えてください。同じフォルダー内で報告書.xlsを上書き保存しさらに4個のsheet(報告書、詳細、依頼書、関連写真)の内、2個のsheet(依頼書、関連写真)を削除した後にsheet(報告書)のセル"Z1"の名前で保存すべく作成したのですが(Z1).xlsが同じフォルダーに作成できません。マイドキュメントに出来てしまいます。 Sub Macro2() Dim strFilePath As String Dim strFileName As String Dim flg As Boolean '◆保存するパスの設定 strFilePath = ThisWorkbook.Path & "\" '◆保存するファイル名の指定 Application.DisplayAlerts = False strFileName = "報告書" ThisWorkbook.SaveAs strFilePath & strFileName Sheets("関連写真").Select ActiveWindow.SelectedSheets.Delete Sheets("依頼書").Select ActiveWindow.SelectedSheets.Delete Sheets("報告書").Select strFilePath = ThisWorkbook.Path & "\" Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ActiveSheet.Range("z1").Value End Sub

  • VBAの印刷について

    VBAでの質問です。 ある処理を施したあとにページ設定をして印刷するプログラムを作成しているのですが、なぜか同じものが2枚出力されてしまいます。 1枚だけ指定して印刷するにはどのようにコードを書けば良いかどなたか教えて下さい。お願いします。 With ActiveSheet.PageSetup 'ページ詳細設定 .PaperSize = xlPaperA4 .Zoom = False .FitToPagesTall = 1       .FitToPagesWide = 1     End With 'ActiveSheet.PrintOut Worksheets(sheetname5).PrintOut ActiveWorkbook.SaveAs Filename:=takiicode & "_" & Format(today, "yyyymmdd") & ".xls" '保存) Workbooks(takiicode & "_" & Format(today, "yyyymmdd") & ".xls").Close SaveChanges:=True '終了

  • 保存したときに毎回出る、不可思議なエラーを回避するには?

    vistaでExcel2007を使用して次のマクロを実行すると Sub MAKE_NEWBOOK_WO_MACROS004() 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブック Dim WBK2 As Workbook ' 作成ブック Dim strFILENAME As String Dim tblSH As Variant Dim lngLines As Long Set WBK1 = ThisWorkbook ' 本ブック ' 指定シートを新規ブックにコピーする Worksheets("印刷").Copy Set WBK2 = ActiveWorkbook strFILENAME = Format(Date, "ggge年m月d日") & ".xls" Application.DisplayAlerts = False フォームコントロール削除 WBK2.SaveAs "請求書" & strFILENAME MsgBox "この請求書 を保存しました。" Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Application.DisplayFormulaBar = False WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub 次のような表示が毎回出ます。 [開こうしているファイルAAAの形式は、ファイル拡張子が示す形式と異なります。このファイルを開く前に、ファイルが破損していないこと、信頼できる発行元からのファイルであることを確認してください。ファイルを今すぐひらきますか?] OKすると、正常にファイルが表示されます。 このエラーを表示させないようにしたいのです。よろしくお願いします。

  • CSV形式で出力後、開くときの警告メッセージについ

    いつもお世話になっております。 ACCESSからデータをCSV形式で出力後、ファイルを開くときに添付のような警告メッセージが表示されます。[はい]をクリックすればファイルは開くことができるのですが、警告メッセージが表示されないようにするにはどうしたらいいでしょうか? xlsxのテンプレートを開き、そこにデータを書き出して、csvで保存するようになっています。csv形式で出力したことがないので、csvのFormatを指定する必要があると思っていますが、どうしたらいいでしょうか? ご教授お願いいたします。 Private Sub CMD_Expo_DblClick(Cancel As Integer) On Error GoTo Err_FileDialog_Click Dim strsql As String Dim strTemplate As String Dim strFileName As String Dim ExpFileName As String Dim xlapp As Object Dim xlWB As Object Dim myCn As New ADODB.Connection Dim myRs As New ADODB.Recordset 'ファイル名作成 ExpFileName = "SNDFILE" & Format(Date, "yyyymmdd") strFileName = GetFileName(False, "", "", ExpFileName & ".csv") 'EXCELアプリケーションを起動 Set xlapp = CreateObject("Excel.Application") 'セットする過程が見えないよう一旦不可視 xlapp.Visible = False Set myCn = CurrentProject.Connection strsql = "Q_BOFAXExpo_MJ" 'レコードセットオープン myRs.Open strsql, myCn, adOpenForwardOnly, adLockReadOnly With xlapp 'テンプレートを開く strTemplate = Application.CurrentProject.Path & "\" & "SNDFILE.xlsx" Set xlWB = .Workbooks.Open(strTemplate) 'テンプレートファイルが存在しないときはエラー If Dir(strTemplate) = "" Then MsgBox "テンプレートファイルを確認してください。", vbOKOnly + vbCritical, "エラー" .Visible = True .Quit Exit Sub End If 'テンプレートファイルオープン .Workbooks.Open strTemplate '結果値出力処理(1行目にヘッダーを表示しているので、2行目1列目からセット xlWB.Worksheets("Sheet1").Cells(1, 1).CopyFromRecordset myRs '完了したら保存 If Len(strFileName) = 0 Then xlWB.Close SaveChanges:=False xlapp.Quit MsgBox "処理を中止します。", vbOKOnly + vbInformation Exit Sub Else xlWB.SaveAs FileName:=strFileName End If MsgBox "BOFAX用のファイルの出力が完了しました。", vbOKOnly + vbInformation End With Set myRs = Nothing: Close Set myCn = Nothing: Close 'Excelを終了します xlapp.Quit Exit Sub Exit_FileDialog_Click: Exit Sub Err_FileDialog_Click: MsgBox "予期せぬエラーが発生しました" & Chr(13) & _ "エラーナンバー:" & Err.Number & Chr(13) & _ "エラー内容:" & Err.Description, vbOKOnly End Resume Exit_FileDialog_Click End Sub

  • loopでファイル名を取得したい

    loopでファイル名を取得して、テキストファイルをエクセルに保存していきたいのですが、 ↓ここ(StrFileName)でエラーになるのですが、どうしたらいいですか? Workbooks.OpenText FileName:=StrFileName, Origin:=932, StartRow:= _ ---------------------------------------- Private Sub コマンド23_Click() Dim StrFileName As String Const EXTENSION As String = ".txt" StrFileName = Dir$(Me!FilePathName & "\*" & EXTENSION) '任意のフォルダを指定 Do Until Len(StrFileName) = 0 'ファイルが無くなったら終了 MsgBox StrFileName Workbooks.OpenText FileName:=StrFileName, Origin:=932, StartRow:= _ 1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _ , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 2), _ Array(10, 1), Array(11, 1), Array(12, 2), Array(13, 1), Array(14, 1), Array(15, 1), Array( _ 16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _ Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array( _ 29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), _ Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 2), Array(40, 1), Array(41, 2), Array( _ 42, 1), Array(43, 1), Array(44, 1)), TrailingMinusNumbers:=True ActiveWorkbook.SaveAs FileName:=FolderName & ActiveSheet.Name, _ FileFormat:=xlNormal, CreateBackup:=False ActiveWorkbook.Close False StrFileName = Dir$ '次のファイル名を取得 Loop End Sub

  • ExcelからWordの差込印刷を実行したい

    WordのFAX送信表にExcelのデータ(宛先)を差込印刷で設定していて、 Excelの方では各行にチェックボックスと一つの印刷ボタンを 配置しています。 ExcelのVBAでチェックがついていたら、A列の値を1として Wordを開き印刷したいのですが、Wordの起動に時間がかかってしまいます。 Wordの方にはクエリオプションでA列=1と設定してあります。 データはExcelでなくても構わないのですが、 何かよい方法はないでしょうか? コードは以下の通りです。 If CheckBox1.Value = True Then Range("A2").Select ActiveCell.FormulaR1C1 = "1" End If Dim ワード As Object Dim ワード文書 As Object Dim フルパス As String フルパス = "C:\Fax送信表.doc" 'フルパスを作成 Set ワード = CreateObject("Word.Application") 'Wordを起動する ワード.Visible = True 'Wordを表示する Set ワード文書 = ワード.documents.Open(フルパス) 'Word文書を開く

  • VBA実行時のエラー

    下記のプログラムは私が作った物では無いのですが、作った方と連絡をとる事が出来なくなってしまった為、質問させて頂きます。 このプログラムをシートから実行した所 エラー:400『既にフォームは表示されています。モーダルにできません。』 なるものが表示されてしまいます。 またコードを記述する所から実行しますと 実行時エラー:1004『アプリケーション定義またはオブジェクト定義のエラー』 となってしまいます。 私の努力が足りないのは重々承知ですが、解決する事が出来ません。 皆様のお力を借りることが出来たらと思い投稿しました。 宜しくお願い致します。 Sub syoutotumen() Dim i As Long Dim j As Long Dim k As Long Dim kyori As Long Dim n As Integer n = 1 i = 1 j = 1 k = 1 Const cnsYEN = "\" Dim xlAPP As Application Dim objWBK As Workbook Dim strPATHNAME As String Dim strFILENAME As String strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理\" If strPATHNAME = "" Then Exit Sub strFILENAME = Dir(strPATHNAME & "dem******", vbNormal) If strFILENAME = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False .EnableEvents = Fales .EnableCancelKey = xlErrorHandler .Cursor = xlWait End With Set WS1 = Worksheets("sheet1") Range("A1") = "0" Range("A2") = "1" Range("A1:A2").Select Selection.AutoFill Destinaton:=Range("A1:A512") Do While strFILENAME <> "" DoEvents If swESC = True Then If MsgBox("ESCが押されました。ここで終了しますか?", vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_Exit Else swESC = False End If End If xlAPP.StatusBar = trFILENAME & "処理中..." Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True) Do If Cells(i, 2) = 255 Then Exit Do i = i + 1 Loop Do If Cells(j, 3) = 255 Then Exit Do j = j + 1 Loop Do If Cells(k, 4) = 255 Then Exit Do k = k + 1 Loop kyori = (i + j + k - 21) / 3 WS1.Cells(n, 2) = kyori n = n + 1 i = 1 j = 1 k = 1 objWBK.Close savechanges:=False strFILENAME = Dir Loop GoTo Button1_Click_Exit Button1_Click_ESC: If Err.Number = 18 Then swESC = True Resume ElseIf Err.Number = 1004 Then Resume Next Else MsgBox Err.Description End If Button1_Click_Exit: With xlAPP .StatusBar = False .ScreenUpdating = True .EnableEvents = True .EnableCancelKey = xlInterrupt .Cursur = xlDefault Set objWBK = Nothing Set xlAPP = Nothing End With End Sub

  • 2010excel の記述方法

    2007excelでマクロを記述したものが、実行エラー1004 「Save As メリッドは失敗しました Workbookオブジェクト」と表示されます。 テバックすると NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 がエラー表示されます。 すいません、教えてください If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close saveChanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8 Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName, FileFormat:=xlExcel8←黄色 End If ' NewWkbook.Close saveChanges:=False Application.DisplayAlerts = True