| |
▼neptune さん：
お返事ありがとうございます。
何とか四苦八苦しながら、一応できるようになりました。
ただ写真を文末に付けようとすると、文章がクリアされてしまうので、
文頭に写真をつけるという少し変な印刷ですが。
以下にコードを書いておきます。
Option Explicit
Dim objWord As New Word.Application 'Wordアプリケーション
Dim objWordDoc As Word.Document 'Wordの新規文書
Private Sub cmb3_Click()
Dim 写真1 As Shape
Dim 写真2 As Shape
Dim 写真3 As Shape
Dim 写真1の場所 As String
Dim 写真2の場所 As String
Dim 写真3の場所 As String
Dim 指定行 As Long
Dim 保存指定フォルダ名 As String
Dim 内容 As String
Dim myReturn As Integer
保存指定フォルダ名 = "C:\mydocuments"
指定行 = 2
写真1の場所 = 保存指定フォルダ名 & "情報\" & 指定行 & "_1.jpg"
写真2の場所 = 保存指定フォルダ名 & "情報\" & 指定行 & "_2.jpg"
写真3の場所 = 保存指定フォルダ名 & "情報\" & 指定行 & "_3.jpg"
Sheets("印刷各種情報").Range("A1") = tbx1.Value 'テキストの内容
内容 = tbx1.Value
On Error GoTo 写真がない場合
With Sheets("印刷各種情報").Range("A3")
Set 写真1 = Sheets("印刷各種情報").Shapes.AddPicture(写真1の場所, False, True, .Left, .Top, .Width, .Height)
End With
With Sheets("印刷各種情報").Range("B3")
Set 写真2 = Sheets("印刷各種情報").Shapes.AddPicture(写真2の場所, False, True, .Left, .Top, .Width, .Height)
End With
With Sheets("印刷各種情報").Range("C3")
Set 写真3 = Sheets("印刷各種情報").Shapes.AddPicture(写真3の場所, False, True, .Left, .Top, .Width, .Height)
End With
Sheets("印刷各種情報").Range("A3:C3").Copy
With objWord
.Visible = True 'Wordを表示
.WindowState = wdWindowStateMaximize 'ウィンドウを最大表示
.Documents.Open 保存指定フォルダ名 & "\情報印刷用.doc"
Set objWordDoc = .ActiveDocument
'文書にテキストを挿入
With .Selection
.PasteSpecial Placement:=wdInLine, DataType:=wdPasteMetafilePicture
.InsertParagraphAfter
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter 内容
End With
End With
'印刷(印刷中はマクロの実行は中断する)
objWord.PrintOut Background:=False
'文書を保存せずに閉じる
objWordDoc.Close SaveChanges:=False
objWord.Quit 'Wordを終了する
Set objWord = Nothing 'オブジェクト変数をクリアする
Set objWordDoc = Nothing
写真がない場合:
Resume Next
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 06/4/13(木) 23:58 -
