Word VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

45 / 45 ﾍﾟｰｼﾞ


	【19】Re:フォルダの中の複数ワープロファイルを１...

らいでん - 03/4/22(火) 23:19 -


	引用なし

	パスワード

らいでんです。
訂正と追記です。

>　　　　If myFile.Type Like "Microsoft Word 文書" _
>　　　　　　And Not myFile Like "~$*" Then

としている所は
　　　　If myFile.Type Like "Microsoft Word 文書" _
　　　　　　And Not myFile.Name Like "~$*" Then
に訂正します。

それから実際にコードを走らせてみると

>　　　　　　Set OldDoc = Documents.Open(myFile.Path)

では、かなりバタバタして忙しい感がありますので
　　　　　　Set OldDoc = Documents.Open( _
　　　　　　　　　　FileName:=myFile.Path, Visible:=False)
とした方が良いかもしれません。

最後にこういったフォルダ内のファイルを総当りして１ファイル
に統合する処理では、ファイルを取り出す順番が重要になりますね。
今回はFileSearch オブジェクトを使用する方法を紹介します。
コードを全て提示してしまうと、面白くないと思いますので
ファイルをソートして取り出す部分だけのサンプルです。
後はご自分で頑張って組み立ててみてください。

Sub Test2()
　　Dim i As Long
　　
　　Application.ScreenUpdating = False
　　
　　With Application.FileSearch
　　　　.NewSearch
　　　　'検索対象フォルダの指定
　　　　.LookIn = "C:\My Documents"
　　　　'サブフォルダを検索対象外
　　　　.SearchSubFolders = False
　　　　.MatchAllWordForms = True
　　　　.FileType = msoFileTypeWordDocuments
　　　　'ファイル名でソートして検索実行
　　　　If .Execute(SortBy:=msoSortByFileName, _
　　　　　　SortOrder:=msoSortOrderAscending) > 0 Then
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　Debug.Print .FoundFiles(i)
　　　　　　　　If InStr(1, .FoundFiles(i), "~$") = 0 Then
　　　　　　　　　　Debug.Print FileLen(.FoundFiles(i))
　　　　　　　　　　'以下ファイルオープン処理等
　　　　　　　　　　'
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　End With
　　
　　Application.ScreenUpdating = True
End Sub

・ツリー全体表示


	【18】Re:フォルダの中の複数ワープロファイルを１...

らいでん - 03/4/21(月) 2:15 -


	引用なし

	パスワード

はじめまして。らいでんです。
私もこちらへは初めての書き込みになります。

以下はサンプルです。VBEの[ツール]→[参照設定]で
「Microsoft Scripting Runtime」にチェックを入れてください。

処理の内容は大雑把に言えば、文書を順に開いてコピー＆新規文書に
ペーストしています。

留意すべき点としては、無限にコピー＆ペーストが行えるわけではなく
Wordファイルサイズの制限に引っかかるので
'ファイルサイズの制限
としている下の行の数値をお使いのWordのバージョンにあわせて
適当に調節してください。（2000以降は32MB。バージョンを明記の事）
もっとも、このサイズ制限の処理はいい加減です。^-^;

Sub Test()
　　Dim Fso As New FileSystemObject
　　Dim myFolder As Folder
　　Dim myFile As File
　　Dim NewDoc As Document
　　Dim OldDoc As Document
　　Dim myRng As Range
　　Dim myFlag As Boolean
　　Dim Fsize As Long
　　
　　Const myPath = "C:\My Documents" 'フォルダ指定
　　myFlag = False

　　Set NewDoc = Documents.Add
　　Set myFolder = Fso.GetFolder(myPath)
　　
　　For Each myFile In myFolder.Files
　　　　If myFile.Type Like "Microsoft Word 文書" _
　　　　　　And Not myFile Like "~$*" Then
　　　　　　Fsize = Fsize + myFile.Size
　　　　　　Debug.Print myFile.Size
　　　　　　'ファイルサイズの制限
　　　　　　If Fsize > 30000000 Then Exit For
　　　　　　Debug.Print myFile.Name
　　　　　　Set OldDoc = Documents.Open(myFile.Path)
　　　　　　DoEvents
　　　　　　With OldDoc
　　　　　　　　.Content.Copy
　　　　　　　　.Close False
　　　　　　End With
　　　　　　Set OldDoc = Nothing
　　　　　　Set myRng = NewDoc.Content
　　　　　　myRng.Collapse Direction:=wdCollapseEnd
　　　　　　If myFlag = True Then
　　　　　　　　myRng.InsertBreak Type:=wdPageBreak
　　　　　　End If
　　　　　　DoEvents
　　　　　　myRng.Paste
　　　　　　myFlag = True
　　　　End If
　　　　DoEvents
　　Next
　　
　　Set myFile = Nothing
　　Set myFolder = Nothing
　　Set Fso = Nothing
　　Set myRng = Nothing
　　Set NewDoc = Nothing
End Sub

・ツリー全体表示


	【17】フォルダの中の複数ワープロファイルを１つ...

ikasumi - 03/4/17(木) 17:45 -


	引用なし

	パスワード

初めまして。VBA始めたばかりの超初心者です。
フォルダの中に入っている複数のワードファイルを改ページしながら
１つのファイルにしたいのですが。
どうすればよろしいのでしょうか？

・ツリー全体表示


	【16】Re:段落番号の書式が設定されているかどうか...

H.C.Shinopy - 03/3/8(土) 11:22 -


	引用なし

	パスワード

段落番号？　段落書式？　
ツールバーでいう[書式]の[箇条書きと段落番号]の設定のことでしょうか？

VBEの右上の[質問を入力してください]欄に、
「ListString」「ListValue」「ListParagraphs」
「ParagraphFormat」「Lists」「ListFormat」
「ListGalleries」と各々入力してみて下さい。
段落番号または行頭文字の付いた箇条書き段落に関するヘルプが表示されます。

以下に、御質問に沿えそうな使用例をヘルプから抜き書きしましたので、
参考にしてみて下さい。

Sub 段落数値文字列()
　Rem 選択範囲の最初の段落の数値と
　Rem その値を表す文字列の両方を表示します。
　v = Selection.Range.ListFormat.ListValue
　lstring = Selection.Range.ListFormat.ListString
　MsgBox "数値 " & v & " は、文字列 [" & lstring & "] で表されます"
End Sub

Sub 各文字スタイル()
　Rem 選択範囲内の各文字のスタイルを表示します｡
　Dim c As Variant
　For Each c In Selection.Characters
　　MsgBox "Style: " & c.Style
　　MsgBox "ParagraphFormat.Style: " & c.ParagraphFormat.Style
　Next c
End Sub

Sub 箇条書き強調()
　Rem 作業中の文書で箇条書き書式が設定された段落のコレクションに、
　Rem 強調表示を設定します。
　For Each para In ActiveDocument.ListParagraphs
　　para.Range.HighlightColorIndex = wdTurquoise
　Next para
End Sub

Sub 箇条書き背景着色()
　Rem　1 番目の文書で、段落番号または行頭文字を
　Rem 使った箇条書きが設定されている各段落の背景を黄色にします。
　For Each numpar In Documents(1).ListParagraphs
　　numpar.Shading.BackgroundPatternColorIndex = wdYellow
　Next numpar
End Sub

Sub 箇条書き二重線()
　Rem 次の使用例は、作業中の文書で
　Rem 2 番目の箇条書きの段落すべてに、二重下線を引きます。
　For Each mypara In ActiveDocument.Lists(2).ListParagraphs
　　mypara.Range.Underline = wdUnderlineDouble
　Next mypara
End Sub

・ツリー全体表示


	【15】段落番号の書式が設定されているかどうかの...

chihiro - 03/2/10(月) 16:54 -


	引用なし

	パスワード

教えていただきたいのですが

段落書式が設定されているかいないかを
VBAで判断するにはどうすればいいのでしょうか？

誰か　お願いします

・ツリー全体表示


	【14】Re:半角全角変換をするには？

ハンサムなオレ - 03/1/28(火) 9:19 -


	引用なし

	パスワード

▼H.C.Shinopy さん：ご丁寧にありがとうございました(*ﾟーﾟ*) 早速自作ツールに組み込ませて頂きます。

・ツリー全体表示


	【13】Re:半角全角変換をするには？

H.C.Shinopy - 03/1/28(火) 2:14 -


	引用なし

	パスワード

これも「Word2002 300の技」に検索のヒントだけが載っていたのですが、
私流に考えて、以下のようなマクロになりました。
全角カタカナの後に続く「・」「ー」（中点・長音符）を半角に変換する処理と、
Officeアシスタントによる「ＯＫ・キャンセル」ボタン処理を付け足しました。
（但し、このボタン処理は「KatakanaHalfWidth」を実行した場合。
御不要な場合は「KatakanaHalfWidthExec」のみ実行して下さい。）
尚、「‐」「ヽ」「ヾ」（ハイフン・カタカナ繰り返し記号）は、
該当する半角文字がないため変換しません。

Sub KatakanaHalfWidth()
' 全角カタカナを半角に変換一括変換
' 記録日 2003/01/27 記録者 Shinopy
　Dim bBeforeRunVisible As Boolean
　Dim iLabelValue As Integer
'
　bBeforeRunVisible = Assistant.Visible
'
　With Assistant
　　.Visible = True
　End With
'
　With Assistant.NewBalloon
　　.Animation = msoAnimationWritingNotingSomething
　　.BalloonType = msoBalloonTypeButtons
　　.Icon = msoIconAlertQuery
　　.Button = msoButtonSetOkCancel
　　.Heading = vbCr + "全角カタカナを半角に" + vbCr + "一括変換"
　　.Text = "ボタンを選択して下さい。"
　　iLabelValue = .Show
　End With
'
　Select Case iLabelValue
　　Case -1 ' [OK]ボタン時
　　　Call KatakanaHalfWidthExec
　　Case -2 ' [キャンセル]ボタン時
　　　With Assistant
　　　　.Animation = msoAnimationIdle
　　　End With
　End Select
'
　With Assistant.NewBalloon
　　If iLabelValue = -2 Then
　　　.Text = "処理が取り消されました。"
　　　.Animation = msoAnimationGetAttentionMajor
　　　.Icon = msoIconAlert
　　Else
　　　.Text = "処理が終了しました。"
　　　.Animation = msoAnimationCharacterSuccessMajor
　　　.Icon = msoIconAlertInfo
　　End If
　　.BalloonType = msoBalloonTypeButtons
　　.Button = msoButtonSetOK
　　.Heading = vbCr + "全角カタカナを半角に" + vbCr + "一括変換"
　　.Show
　End With
　Assistant.NewBalloon.Close
　Assistant.Visible = bBeforeRunVisible
End Sub ' KatakanaHalfWidth　　*----*----*
Sub KatakanaHalfWidthExec()
' 記録日 2003/01/27 記録者 Shinopy
' 「‐」「ヽ」「ヾ」（連字符・繰り返し記号）は、変換しません。
　Dim cKatakana As String
　cKatakana = "[ァ-" & ChrW(Val("&h30FA")) & "]"　'　&h30FA : 「ヲ゛」
' *----*
' 全角カタカナの後に続く中点・長音符を半角に変換
　Selection.Words(1).Select
　Selection.Collapse wdCollapseStart
'
　With Selection.Find
　　.ClearFormatting
　　.Text = cKatakana & "{1,}" & "([・ー]{1,})"
　　.Replacement.Text = ""
　　.Forward = True
　　.Wrap = wdFindContinue
　　.Format = False
　　.MatchCase = False
　　.MatchWholeWord = False
　　.MatchByte = False
　　.MatchAllWordForms = False
　　.MatchSoundsLike = False
　　.MatchFuzzy = False
　　.MatchWildcards = True
　End With
'
　Do While Selection.Find.Execute
　　With Selection.Range
　　　.CharacterWidth = wdWidthHalfWidth
　　End With
　　Selection.Collapse wdCollapseEnd
　Loop
' *----*
' 全角カタカナを半角に変換
　Selection.Words(1).Select
　Selection.Collapse wdCollapseStart
'
　With Selection.Find
　　.ClearFormatting
　　.Text = cKatakana & "{1,}"
　　.Replacement.Text = ""
　　.Forward = True
　　.Wrap = wdFindContinue
　　.Format = False
　　.MatchCase = False
　　.MatchWholeWord = False
　　.MatchByte = False
　　.MatchAllWordForms = False
　　.MatchSoundsLike = False
　　.MatchFuzzy = False
　　.MatchWildcards = True
　End With
'
　Do While Selection.Find.Execute
　　With Selection.Range
　　　.CharacterWidth = wdWidthHalfWidth
　　End With
　　Selection.Collapse wdCollapseEnd
　Loop
End Sub ' KatakanaHalfWidthExec　　*----*----*

・ツリー全体表示


	【12】Re:半角全角変換をするには？

ハンサムなオレ - 03/1/27(月) 14:40 -


	引用なし

	パスワード

便乗質問でスミマセン。全角カタカナから半角ｶﾀｶﾅに変換する方法も教えて下さい。

・ツリー全体表示


	【11】Re:半角全角変換をするには？

H.C.Shinopy - 03/1/22(水) 19:44 -


	引用なし

	パスワード

技術評論社の書籍「Word2002 300の技」に
112番目の技として以下のようなマクロが載っています。
（1箇所だけ、私が手を加えて変更しています。
「Selection.Font.Scaling = 50」で文字幅を50%に指定し、
半角文字と同じ幅になるようにしています。
御不要な場合は、この行を削除して下さい。）

尚、文字列変換の対象は「本文」です。
「オブジェクト」のほうは、どうにも判りません。
お許し下さい。

Sub 半角カタカナ全角変換()
　Selection.Words(1).Select
　Selection.Collapse wdCollapseStart
'
　Selection.Find.ClearFormatting
　With Selection.Find
　　.Text = "[ｦ-ﾟ]{1,}"
　　.Replacement.Text = ""
　　.Forward = True
　　.Wrap = wdFindContinue
　　.Format = False
　　.MatchCase = False
　　.MatchWholeWord = False
　　.MatchByte = False
　　.MatchAllWordForms = False
　　.MatchSoundsLike = False
　　.MatchFuzzy = False
　　.MatchWildcards = True
　End With
'
　Do While Selection.Find.Execute
　　With Selection.Range
　　　.CharacterWidth = wdWidthFullWidth
　　　Selection.Font.Scaling = 50
　　End With
　　Selection.Collapse wdCollapseEnd
　Loop
End Sub　'　半角カタカナ全角変換　　*----*----*

・ツリー全体表示


	【10】半角全角変換をするには？

YYS - 02/12/26(木) 17:39 -


	引用なし

	パスワード

はじめて質問致します。
word文章に半角カナ文字が入っていたとします。
これを全て全角に変換する方法があれば教えてください。
なお、対象は「本文」「オブジェクト（可能であれば）」
です。
よろしくお願いします。

・ツリー全体表示


	【9】WORDマクロの解説本について教えてください

ＦＩＮ - 02/11/13(水) 16:57 -


	引用なし

	パスワード

WORD2000や2002に対応したWORDマクロのお勧め解説本って何か
ありますか？

・ツリー全体表示


	【8】Re:チェックの仕方について

yu-ji - 02/10/7(月) 9:37 -


	引用なし

	パスワード

▼ためやんさん：
>□内にレ点を挿入したいのですが方法がわかりません。
>どなたか教えていただけたら幸いです。
>宜しくお願いします。

□というのは、チェックボックスでいいんでしょうか？
＃文字の□じゃないですよね？

普通に、

If CheckBox1.Value = True Then
　CheckBox1.Value = False
Else
　CheckBox1.Value = True
End If

という感じで使えます。

・ツリー全体表示


	【7】チェックの仕方について

ためやん - 02/10/1(火) 10:26 -


	引用なし

	パスワード

□内にレ点を挿入したいのですが方法がわかりません。
どなたか教えていただけたら幸いです。
宜しくお願いします。

・ツリー全体表示


	【6】Re:2002で差込印刷

Rinko - 02/9/10(火) 22:27 -


	引用なし

	パスワード

自己レスです。解決しました。
自動記録をあきらめ、マイクロソフトのサポート記事などを参考に
してなんとか2002での差込印刷を自動化できました。
ありがとうございました。

・ツリー全体表示


	【5】2002で差込印刷

Rinko - 02/9/9(月) 23:27 -


	引用なし

	パスワード

はじめまして。はじめて過去の質問箱からお邪魔しました。
エクセルの住所録を差し込んで宛名ラベルを作成するマクロを自動記録
したのですが、実行できません。
XP、2002で差込印刷ウィザードを印刷終了までしました。
マクロでお使いの方がいらっしゃいましたら、教えてください！
2000ではできたんですが。。

←のところで実行時エラー509　このコマンドは使用できません。
となります。１件目に入っているだけでした。どう修正したらいいのでしょうか。
印刷終了まで記録しています。差し込んだラベルがレイアウトされれば、あとは
手動で印刷してもいいのですが、エラーまでではそれができていません。
ちなみにこの１行を消したところ、１件づつラベルシートの１件目を使って印刷され、連続では差し込まれていませんでした。

～省略
Selection.TypeText Text:="　〒"
　　ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
　　　　, Text:="""郵便番号"""
　　Selection.TypeParagraph
　　Selection.TypeText Text:="　"
　　ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
　　　　, Text:="""住所１"""
　　Selection.TypeParagraph
　　Selection.TypeText Text:="　"
　　ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
　　　　, Text:="""住所２"""
　　Selection.TypeParagraph
　　Selection.MoveDown Unit:=wdLine, Count:=1
　　Selection.TypeText Text:="　　　"
　　ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
　　　　, Text:="""氏名"""
　　Selection.TypeText Text:="　　様"
　　WordBasic.MailMergePropagateLabel　←ここで実行時エラー509　
　　With ActiveDocument.MailMerge
　　　　.Destination = wdSendToPrinter
　　　　.SuppressBlankLines = True
　　　　With .DataSource
　　　　　　.FirstRecord = wdDefaultFirstRecord
　　　　　　.LastRecord = wdDefaultLastRecord
　　　　End With
　　　　.Execute Pause:=False
　　End With
　　CommandBars("Task Pane").Visible = False
End Sub

・ツリー全体表示


	【4】Re:実験

じっけん

- 02/8/26(月) 0:27 -


	引用なし

	パスワード

さらにじっけん。
▼じっけんさん：
>▼谷誠之さん：
>>これは実験用の書き込みです。

・ツリー全体表示


	【3】Re:実験

じっけん

- 02/8/26(月) 0:26 -


	引用なし

	パスワード

▼谷誠之さん：
>これは実験用の書き込みです。

・ツリー全体表示


	【2】実験

谷誠之

- 02/8/25(日) 3:37 -


	引用なし

	パスワード

これは実験用の書き込みです。

・ツリー全体表示


	【1】Word VBA 質問箱新装開店

谷誠之

- 02/8/19(月) 16:16 -


	引用なし

	パスワード

VBA研究所の主宰者、谷です。

おかげさまで、VBA質問箱も第４弾。
今後とも、どうぞよろしくお願いいたします。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

45 / 45 ﾍﾟｰｼﾞ

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free