goo blog サービス終了のお知らせ 

korondemoのメモ

記憶の助けとして

ファイルの作成者の変更

2008-10-03 20:28:26 | Word
他のソフト(Excelなど)のVBAで
フォルダ
c:\test
の中の拡張子が
doc
のファイルの作成者を
def
に変更する例です.

Microsoft Word ??.? Object Library
への参照設定をしておきます.

Sub test()

Dim app1 As New Word.Application
Dim doc1 As New Word.Document
Dim namae As String

namae = Dir("c:\test\*.doc")

Do While namae <> ""

Set doc1 = app1.Documents.Open("c:\test\" & namae)

With doc1

.BuiltinDocumentProperties("Author") = "def"
.Saved = False
.Save
.Close

End With

namae = Dir()
Loop

Set doc1 = Nothing
app1.Quit
Set app1 = Nothing
End Sub

クリップボードの中身を拡張メタファイルに保存

2007-10-23 15:59:12 | Word
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hWndNewOwner As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal uFormat As Long) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" _
Alias "CopyEnhMetaFileA" _
(ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
(ByVal hemf As Long) As Long

Sub SaveEMF(fName As String)
Dim h As Long, r As Long
If OpenClipboard(0) = 0 Then Exit Sub
h = GetClipboardData(14)
If h Then
r = CopyEnhMetaFile(h, fName)
If r Then
DeleteEnhMetaFile r
End If
DeleteEnhMetaFile h
End If
CloseClipboard
End Sub

たとえば

SaveEMF "c:\test.emf"

のようにして保存します.

トンボ付き印刷

2007-05-13 19:51:02 | Word
A4 の用紙の中央に B5 用の文書を印刷します.
ページ設定で
用紙は A4 に
印刷の向きはとりあえず縦の状態で
上下の余白は 20 mm ずつ
左右の余白は 14 mm ずつ
あらかじめ増やして設定しておきます.

以降は印刷の向きを横に変更しても
上下の余白と左右の余白が自動で入れ替わってくれるので
大丈夫ですが
変更した場合は再度実行する必要があります.
左の余白を変えた場合も再度実行する必要があります.

Sub tonbo()
a4w = MillimetersToPoints(210)
a4h = MillimetersToPoints(297)
b5w = MillimetersToPoints(182)
b5h = MillimetersToPoints(257)
l1 = 8.5
With ActiveDocument.PageSetup
If .Orientation = wdOrientLandscape Then
h1 = (a4w - b5w) * 0.5
w1 = (a4h - b5h) * 0.5
Else
w1 = (a4w - b5w) * 0.5
h1 = (a4h - b5h) * 0.5
End If
w2 = .PageWidth - w1
h2 = .PageHeight - h1
End With
w3 = (w1 + w2) * 0.5
h3 = (h1 + h2) * 0.5
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
For i = .Shapes.Count To 1 Step -1
.Shapes(i).Delete
Next
With .Shapes
.AddLine w1 - 3 * l1, h1 - l1, w1, h1 - l1
.AddLine w1, h1 - 3 * l1, w1, h1 - l1
.AddLine w1 - 3 * l1, h1, w1 - l1, h1
.AddLine w1 - l1, h1 - 3 * l1, w1 - l1, h1

.AddLine w2 + 3 * l1, h1 - l1, w2, h1 - l1
.AddLine w2, h1 - 3 * l1, w2, h1 - l1
.AddLine w2 + 3 * l1, h1, w2 + l1, h1
.AddLine w2 + l1, h1 - 3 * l1, w2 + l1, h1

.AddLine w1 - 3 * l1, h2 + l1, w1, h2 + l1
.AddLine w1, h2 + 3 * l1, w1, h2 + l1
.AddLine w1 - 3 * l1, h2, w1 - l1, h2
.AddLine w1 - l1, h2 + 3 * l1, w1 - l1, h2

.AddLine w2 + 3 * l1, h2 + l1, w2, h2 + l1
.AddLine w2, h2 + 3 * l1, w2, h2 + l1
.AddLine w2 + 3 * l1, h2, w2 + l1, h2
.AddLine w2 + l1, h2 + 3 * l1, w2 + l1, h2

.AddLine w3 - 3 * l1, h1 - 2 * l1, w3 + 3 * l1, h1 - 2 * l1
.AddLine w3, h1 - 3 * l1, w3, h1 - l1

.AddLine w3 - 3 * l1, h2 + 2 * l1, w3 + 3 * l1, h2 + 2 * l1
.AddLine w3, h2 + 3 * l1, w3, h2 + l1

.AddLine w1 - 3 * l1, h3, w1 - l1, h3
.AddLine w1 - 2 * l1, h3 - 3 * l1, w1 - 2 * l1, h3 + 3 * l1

.AddLine w2 + 3 * l1, h3, w2 + l1, h3
.AddLine w2 + 2 * l1, h3 - 3 * l1, w2 + 2 * l1, h3 + 3 * l1
End With
End With
End Sub

一太郎にはトンボを付けて印刷する設定があります.

便箋2

2007-01-16 12:22:40 | Word
Sub binsen2()
kankaku = ActiveDocument.GridDistanceVertical * 2
With ActiveDocument.PageSetup
yoko0 = .LeftMargin
tate0 = .TopMargin
gyou = .LinesPage
haba = .PageWidth - yoko0 - .RightMargin
takasa = .PageHeight - tate0 - .BottomMargin
End With
yoko1 = yoko0 + haba
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
For i = .Shapes.Count To 1 Step -1
.Shapes(i).Delete
Next
With .Shapes
If ActiveDocument.Content.Orientation = wdTextOrientationVerticalFarEast Then
tate1 = tate0 + takasa
For i = 0 To gyou
yoko2 = yoko1 - i * kankaku
.AddLine yoko2, tate0, yoko2, tate1
Next
Else
For i = 1 To gyou
tate1 = tate0 + i * kankaku
.AddLine yoko0, tate1, yoko1, tate1
Next
End If
End With
End With
End Sub

便箋

2007-01-15 20:24:25 | Word
行送りはどうやって取得したらいいやら

Sub binsen()
With ActiveDocument.PageSetup
yoko0 = .LeftMargin
tate0 = .TopMargin
gyou = .LinesPage
haba = .PageWidth - yoko0 - .RightMargin
takasa = .PageHeight - tate0 - .BottomMargin
End With
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
For i = .Shapes.Count To 1 Step -1
.Shapes(i).Delete
Next
With .Shapes
If ActiveDocument.Content.Orientation = wdTextOrientationVerticalFarEast Then
tate1 = tate0 + takasa
yoko2 = haba / gyou
For i = 0 To gyou
yoko1 = yoko0 + i * yoko2
.AddLine yoko1, tate0, yoko1, tate1
Next
Else
yoko1 = yoko0 + haba
tate2 = takasa / gyou
For i = 1 To gyou
tate1 = tate0 + i * tate2
.AddLine yoko0, tate1, yoko1, tate1
Next
End If
End With
End With
End Sub

原稿用紙のマス目

2006-09-19 18:01:14 | Word
Sub masume()
With ActiveDocument.PageSetup
yoko0 = .LeftMargin
tate0 = .TopMargin
mozi = .CharsLine
gyou = .LinesPage
haba = .PageWidth - yoko0 - .RightMargin
takasa = .PageHeight - tate0 - .BottomMargin
End With
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
For i = .Shapes.Count To 1 Step -1
.Shapes(i).Delete
Next
With .Shapes
.AddShape msoShapeRectangle, yoko0, tate0, haba, takasa
If ActiveDocument.Content.Orientation = wdTextOrientationVerticalFarEast Then
masu = takasa / mozi
sukima = (haba - masu * gyou) / gyou
masus = masu + sukima
yoko0 = yoko0 + sukima * 0.5
tate1 = tate0 + takasa
For i = 0 To gyou - 1
yoko1 = yoko0 + i * masus
yoko2 = yoko1 + masu
.AddLine yoko1, tate0, yoko1, tate1
.AddLine yoko2, tate0, yoko2, tate1
For j = 1 To mozi - 1
tate = tate0 + j * masu
.AddLine yoko1, tate, yoko2, tate
Next
Next
Else
masu = haba / mozi
sukima = (takasa - masu * gyou) / gyou
masus = masu + sukima
tate0 = tate0 + sukima * 0.5
yoko1 = yoko0 + haba
For i = 0 To gyou - 1
tate1 = tate0 + i * masus
tate2 = tate1 + masu
.AddLine yoko0, tate1, yoko1, tate1
.AddLine yoko0, tate2, yoko1, tate2
For j = 1 To mozi - 1
yoko = yoko0 + j * masu
.AddLine yoko, tate1, yoko, tate2
Next
Next
End If
End With
End With
End Sub

原稿用紙の21文字目をマスの中に

2006-08-10 14:23:25 | Word
Selection.WholeStory
Selection.Font.Spacing = 0
Selection.HomeKey Unit:=wdStory
w = 2
While w > 1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
If Selection.Characters.Count > 20 Then
Selection.HomeKey Unit:=wdLine
Selection.MoveRight Count:=19
Selection.MoveRight Extend:=wdExtend
Selection.Font.Spacing = -6
Selection.MoveRight
Selection.MoveRight Extend:=wdExtend
Selection.Font.Spacing = 6
End If
w = Selection.Move(Unit:=wdLine, Count:=2)
Selection.Move Unit:=wdLine, Count:=-1
Wend

Excel から差し込んだ場合の書式

2006-01-08 14:58:30 | Word
どのバージョンからか分かりませんが
デフォルトでは書式が維持されなくなりました.

メニューバーから
ツール => オプション
[全般]タブを選択
文書を開くときにファイル形式を確認する
にチェックを入れておきますと
データソースとして Excel のファイルを開くときに
[データファイル形式の確認]の画面が出てきますので
そのときに
Microsoft Excel ワークシート DDE (*.xls)
を選択しますと書式が維持されます.

また
下記のようにフィールドコードを編集することでも
書式の変更は可能です.

たとえば数値に桁区切りを入れたい場合は

挿入されている数値の上で右クリック
[フィールドコードの表示/非表示]を選択
たとえば
{ MERGEFIELD "数値" }
となっていた場合
これを編集して
{ MERGEFIELD "数値" \\# #,##0 }
と変え,その上で右クリック
[フィールドコードの表示/非表示]を選択
もう一度その上で右クリック
[フィールド更新]を選択です.

日付を年号付きで
平成 18 年 1 月 1 日
のように表示させたい場合は
たとえば
{ MERGEFIELD "日付" }
となっていた場合
これを編集して
{ MERGEFIELD "日付" \\@ "ggge年M月d日" }
とします.