Excel VBA質問箱 IV

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

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


33778 / 76738 ←次へ | 前へ→

【48176】Re:開くファイルの制御
発言  ウッシ  - 07/4/6(金) 15:24 -

引用なし
パスワード
   こんにちは

>例えば,開くExcelブック名を間違えてセルに記入した場合,当然,エラーが出るの
>ですが,これを正しく修正
問題はこちらの部分で、存在しないファイ名だった場合や、全く対象でないファイルを
指定してしまった時に、きちんとマクロを終わらせるようにして下さいという意味の
コードを前回は提示しました。
エラーで強制終了したままですとWordのインスタンス等が残ってる場合が発生するかも
知れません。

下記のような感じで試してエラーの際にどのようなエラーメッセージが表示されるのか
提示して下さい。
またその時のイミディエイトウィンドウの「TEXT_LEFT」及び「TEXT_TOP」の値が
どうなっているのか調べて下さい。

Sub CopyPasteWord_1()
  Dim objWord   As Object
  Dim objDoc    As Object
  Dim WkBook    As Workbook
  Dim WkSht    As Worksheet
  Dim BOOK     As String
  Dim wordfilename As Variant
  Dim OPENBOOK   As String
  
  BOOK = ThisWorkbook.Sheets(1).Cells(12, 2)
  OPENBOOK = ThisWorkbook.Path & "\" & BOOK & ".xls"
  If Len(Dir(OPENBOOK)) = 0 Then Exit Sub
  
  With Application
    .AskToUpdateLinks = False
    .DisplayAlerts = False
  
    Set WkBook = Workbooks.Open(OPENBOOK)
    
    wordfilename = Application.GetOpenFilename _
        (Title:="ファイルを開く", _
         FileFilter:="Word 文書(*.doc),*doc")
        '事情によりWordだけGetOpenFilenameメソッドを利用しています
    If VarType(wordfilename) = vbBoolean Then
      WkBook.Close False
      Set WkBook = Nothing
      Exit Sub
    End If
    
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
    If objWord Is Nothing Then
      Set objWord = CreateObject("Word.Application")
      Set objDoc = objWord.documents.Open(wordfilename)
    Else
      Set objDoc = GetObject(wordfilename)
    End If
    On Error GoTo 0
    
    With objWord
      .Visible = True
      .WindowState = 1 'wdWindowStateMaximize
    
    End With

    Set WkSht = WkBook.Worksheets(1)
    
    'コードは省略します。

    'ここでExcelからWordにCopyPaste
    With objWord.Selection
      .ParagraphFormat.Alignment = wdAlignParagraphLeft
      With .Font
        .Size = 12
        .Name = "MS ゴシック"
      End With
      .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
          Placement:=wdFloatOverText, DisplayAsIcon:=False
      .ShapeRange.RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionMargin
      .ShapeRange.RelativeVerticalPosition = _
        wdRelativeVerticalPositionMargin
      .ShapeRange.ScaleWidth TEXT_SIZE, True
                      'TEXT_SIZEはセルから取得しています。
      .ShapeRange.ScaleHeight TEXT_SIZE, True
      
      Debug.Print "TEXT_LEFT=" & TEXT_LEFT & " :: TEXT_TOP=" & TEXT_TOP      
      If TEXT_LEFT <> "" Then
        .ShapeRange.Left = MillimetersToPoints(TEXT_LEFT)
                      'TEXT_LEFTもセルから取得しています。
        .ShapeRange.Top = MillimetersToPoints(TEXT_TOP)
                      'TEXT_TOPもセルから取得しています。
      End If
      
      .MoveLeft
    End With
      
    'コードは省略します。
      
      
    objDoc.Close
    If objWord.document.Count = 0 Then
      objWord.Quit
    End If
    
    WkBook.Close
    
    .DisplayAlerts = True
    .AskToUpdateLinks = True
  End With
  Set objWord = Nothing
  Set objDoc = Nothing
  Set WkBook = Nothing
  Set WkSht = Nothing
End Sub

1 hits

【48152】開くファイルの制御 tomo 07/4/5(木) 13:18 質問
【48154】Re:開くファイルの制御 ウッシ 07/4/5(木) 13:53 発言
【48161】Re:開くファイルの制御 tomo 07/4/5(木) 16:14 お礼
【48162】Re:開くファイルの制御 ウッシ 07/4/5(木) 16:29 発言
【48163】Re:開くファイルの制御 tomo 07/4/5(木) 17:31 質問
【48164】Re:開くファイルの制御 ウッシ 07/4/5(木) 17:42 発言
【48167】Re:開くファイルの制御 tomo 07/4/5(木) 18:34 お礼
【48175】Re:開くファイルの制御 tomo 07/4/6(金) 14:04 質問
【48176】Re:開くファイルの制御 ウッシ 07/4/6(金) 15:24 発言
【48177】Re:開くファイルの制御 ウッシ 07/4/6(金) 15:42 発言
【48178】Re:開くファイルの制御 tomo 07/4/6(金) 19:18 発言
【48179】Re:開くファイルの制御 ウッシ 07/4/6(金) 20:39 発言
【48221】Re:開くファイルの制御 tomo 07/4/9(月) 9:05 発言
【48222】Re:開くファイルの制御 ウッシ 07/4/9(月) 9:43 発言
【48223】Re:開くファイルの制御 tomo 07/4/9(月) 9:48 お礼
【48235】Re:開くファイルの制御 りん 07/4/9(月) 17:52 発言
【48251】Re:開くファイルの制御 tomo 07/4/10(火) 8:18 お礼

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