 Re: ワードのマクロ 図の書式設定 ( No.1 ) |
- 日時： 2024/02/09 17:01
- 名前： ゆたか
- 以下をお試しください。
１．以下のコードを貼り付けた文書を作成し保存します。文書Aとします。
２．画像を貼り付けた文書を作成し保存します。文書Bとします。文書Bは閉じます。
３．文書Aと文書Bを同じフォルダに入れます。
４．文書Aのmain()を実行します。
５．どの文書を対象にするか聞いてくるので文書Bを指定します。
６．同じフォルダにベージ毎のカラーとグレイスケールのPDFが作成されます。
Option Explicit
Sub main()
Debug.Print Time
OpenDocument
AdjustAllPhotos
EachPage2PDF ("Color")
GreyscaleAllPhotos
EachPage2PDF ("Greyscale")
CloseDocument
Debug.Print Time
End Sub
' 画像を調整する
Sub AdjustAllPhotos()
Dim i As Long
Dim cnt As Long
cnt = ActiveDocument.InlineShapes.count
If cnt = 0 Then Exit Sub
For i = 1 To cnt
ActiveDocument.InlineShapes(i).PictureFormat.Brightness = 0.6
ActiveDocument.InlineShapes(i).PictureFormat.Contrast = 0.65
ActiveDocument.InlineShapes(i).Fill.PictureEffects.Insert(msoEffectSharpenSoften).EffectParameters(1).Value = 0.4
ActiveDocument.InlineShapes(i).Fill.PictureEffects.Insert(msoEffectSaturation).EffectParameters(1).Value = 1.1
ActiveDocument.InlineShapes(i).Fill.PictureEffects.Insert(msoEffectColorTemperature).EffectParameters(1).Value = 7200
Next i
End Sub
' 画像をグレイスケールにする
Sub GreyscaleAllPhotos()
Dim i As Long
Dim cnt As Long
cnt = ActiveDocument.InlineShapes.count
If cnt = 0 Then Exit Sub
For i = 1 To cnt
ActiveDocument.InlineShapes(i).PictureFormat.ColorType = msoPictureGrayscale
Next i
End Sub
' 対象ファイルを開く
' 参考：https://excel-ubara.com/excelvba1/EXCELVBA376.html
Sub OpenDocument()
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Word", "*.doc*"
.InitialFileName = ThisDocument.Path & "\"
.AllowMultiSelect = False
If .Show = True Then
.Execute
End If
End With
End Sub
' 対象ファイルを閉じる
Sub CloseDocument()
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges ' 変更は保存しない
End Sub
' １ページ毎にPDFファイルにして保存
' 参考：https://kn-sharoushi.com/20230120about_word2pdf/
Public Sub EachPage2PDF(str As String)
Dim pg As Page
Dim doc As Document
Dim lNum As Long
Dim stName As String
Set doc = ActiveDocument
For Each pg In doc.ActiveWindow.ActivePane.Pages
'ページ番号を取得
lNum = pg.Rectangles(1).Lines(1).Range.Information(wdActiveEndAdjustedPageNumber)
stName = doc.Name & "_" & str & "_P" & lNum
'文末の改行コードはトル
If Right(stName, 1) = vbCr Or Right(stName, 1) = vbLf Or Right(stName, 1) = vbCrLf Then stName = Left(stName, Len(stName) - 1)
'PDF保存用パス
stName = doc.Path & "\" & stName & ".pdf"
'ページを指定してPDF化
doc.ExportAsFixedFormat OutputFileName:=stName, _
Range:=wdExportFromTo, From:=lNum, To:=lNum, _
ExportFormat:=wdExportFormatPDF
Next pg
Set doc = Nothing
End Sub
 |
|
ワードのマクロ 図の書式設定