| |
最初考えてたより、てこずっちゃいました。
Sub 使いかけラベルシートで差込印刷()
Dim doc As Document
Dim i As Long
Dim t As Long, n As Long
Dim n1 As Long, n2 As Long
Dim msg As String
Dim p As Long
Dim c As Cell
Const cnt As Long = 8 'ラベル数／シート
Set doc = MacroContainer
With doc.MailMerge
With .DataSource
'使用済み枚数（空レコード数）の計算
.ActiveRecord = wdFirstDataSourceRecord
For i = 1 To cnt - 1
If .Included Then n1 = n1 + 1
.ActiveRecord = wdNextDataSourceRecord
Next
'差込レコード数の計算
.ActiveRecord = wdLastRecord
t = .ActiveRecord
.ActiveRecord = wdFirstRecord
n = 1
Do Until .ActiveRecord = t
.ActiveRecord = wdNextRecord
n = n + 1
Loop
End With
msg = "シートの" & n1 + 1 & "枚目から" & n - n1 & "枚印刷します"
If MsgBox(msg, vbOKCancel) <> vbOK Then Exit Sub
'差込文書作成
.Destination = wdSendToNewDocument
.SuppressBlankLines = False
.Execute
End With
'最初のシートの不要ラベルを削除
Set c = ActiveDocument.Tables(1).Cell(1, 1)
For i = 1 To n1
Do While c.Range.Words.Count = 1
Set c = c.Next
Loop
c.Range.Text = ""
Set c = c.Next
Next
'最終シートの不要ラベルを削除
p = ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
n2 = cnt - (n Mod cnt)
With ActiveDocument.Tables(p)
Set c = .Cell(.Rows.Count, .Columns.Count)
End With
If n2 < cnt Then
For i = 1 To n2
Do While c.Range.Words.Count = 1
Set c = c.Previous
Loop
c.Range.Text = ""
Set c = c.Previous
Next
End If
End Sub
|
|
こっこ
- 15/10/8(木) 15:46 -
マリモ
- 15/3/29(日) 9:26 -
マナ
- 15/3/28(土) 10:45 -
