Word VBA質問箱 IV

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

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


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

2 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【891】wordについて。

コルム - 19/7/18(木) 16:24 -


	引用なし

	パスワード

wordで、便箋をtab キーを使って作る方法を教えていただけると幸いです。
表を挿入して、8行1列の表を挿入して、tabキーを使って、20行まで増やすやり方でも良いのでしょうか？後で、表示形式を、右罫線、左罫線を消して、横線を、破線を選べば良いのでしょうか？教えていただけると幸いです。
https://6900.teacup.com/cgu135/bbs/803

・ツリー全体表示


	【890】Re:検索文字の後ろに文字挿入

あおぎんこ - 19/7/5(金) 12:06 -


	引用なし

	パスワード

▼マナさん：

>この通りしていますか。
>変更していませんか。

すみません！
きちんとコードを転機できておりませんでした。
修正しましたところ、目的の動作ができました。

ありがとうございました。
大変助かりました。

・ツリー全体表示


	【889】Re:検索文字の後ろに文字挿入

マナ - 19/7/4(木) 20:17 -


	引用なし

	パスワード

▼あおぎんこさん：

>検索文字の後ではなく、ファイルのいちばん最後に文字が挿入されます。

>>　　　　　　wrdRng.InsertAfter "挿入文字"

この通りしていますか。
変更していませんか。

・ツリー全体表示


	【888】Re:検索文字の後ろに文字挿入

あおぎんこ - 19/7/4(木) 19:23 -


	引用なし

	パスワード

▼マナさん：

さっそくの回答ありがとうございます。
ご提示のコードに変更しましたら、エラーは出なくなりました！

しかしながら、、
検索文字の後ではなく、ファイルのいちばん最後に文字が挿入されます。

質問ばかりで申し訳ないですが、解決方法がありましたら、ご教示いただ
けるとありがたいです。

よろしくお願いいたします。

>▼あおぎんこさん：
>
>Sub test()
>　　Dim strFile As String
>　　Dim wrdApp As Object
>　　Dim wrdDoc As Object
>　　Dim wrdRng As Object
>　
>　　strFile = "ダイアログで選択したWordファイルのフルパス"
>　　
>　　Set wrdApp = CreateObject("Word.Application")
>　　w rdApp.Visible = True
>　　Set wrdDoc = wrdApp.Documents.Open(strFile)　'指定のワードファイルを開く
>
>　　Set wrdRng = wrdDoc.Range
>　　With wrdRng.Find
>　　　　.Text = "検索文字"
>　　　　If .Execute Then
>　　　　　　wrdRng.InsertAfter "挿入文字"
>　　　　End If
>　　End With
>
>　　'～ファイル保存処理～
>　
>End Sub

・ツリー全体表示


	【887】Re:検索文字の後ろに文字挿入

マナ - 19/7/3(水) 23:07 -


	引用なし

	パスワード

▼あおぎんこさん：

>ご提示のコードを組み込んでみましたところ、Set r = ActiveDocument.Range　
>のところで型が一致しません　と出ます。

Sub test()
　　Dim strFile As String
　　Dim wrdApp As Object
　　Dim wrdDoc As Object
　　Dim wrdRng As Object
　
　　strFile = "ダイアログで選択したWordファイルのフルパス"
　　
　　Set wrdApp = CreateObject("Word.Application")
　　w rdApp.Visible = True
　　Set wrdDoc = wrdApp.Documents.Open(strFile)　'指定のワードファイルを開く

　　Set wrdRng = wrdDoc.Range
　　With wrdRng.Find
　　　　.Text = "検索文字"
　　　　If .Execute Then
　　　　　　wrdRng.InsertAfter "挿入文字"
　　　　End If
　　End With

　　'～ファイル保存処理～
　
End Sub

・ツリー全体表示


	【886】Re:検索文字の後ろに文字挿入

あおぎんこ - 19/7/3(水) 14:29 -


	引用なし

	パスワード

▼マナさん：

回答ありがとうございます。
そして、すっかりお礼が遅くなって申し訳ありません。

ご提示のコードを組み込んでみましたところ、Set r = ActiveDocument.Range　
のところで型が一致しません　と出ます。
いただいたtestコードをwordで実行するとうまくいくので、これを元に何とか
しようと思ったのですが、行き詰っております。
エクセルから操作しているので、うまくいかないのでしょうか・・？？
ご教示いただけるとありがたいです。。

よろしくお願いいたします。

Sub サンプル()

Dim strFile As String
Dim wrdApp As Object
Dim wrdDoc As Object
Dim wrdRng As Object
　　
　strFile = "ダイアログで選択したWordファイルのフルパス"
　　　　
　Set wrdApp = CreateObject("Word.Application")’ワードを開く
　wrdApp.Visible = True
　Set wrdDoc = wrdApp.Documents.Open(strFile)　'指定のワードファイルを開く
　　wrdDoc.Range.WholeStory
　　　
　　Dim r As Range
　 Set r = ActiveDocument.Range　←「型が一致しません」
　　
　　With r.Find
　　　　.Text = "検索文字"
　　　　If .Execute Then
　　　　　　r.InsertAfter "挿入文字"
　　　　End If
　　End With

　'～ファイル保存処理～
　
　　
End Sub

>▼あおぎんこさん：
>
>Sub test()
>　　Dim r As Range
>　　
>　　Set r = ActiveDocument.Range
>　　
>　　With r.Find
>　　　　.Text = "検索文字"
>　　　　If .Execute Then
>　　　　　　r.InsertAfter "挿入文字"
>　　　　End If
>　　End With
>
>End Sub

・ツリー全体表示


	【885】Re:ファイル分割

ころんさん - 19/6/30(日) 8:20 -


	引用なし

	パスワード

マナさん、助言ありがとうございます。
ページ削除の対応で、問題なく分割することができました。

・ツリー全体表示


	【884】Re:ファイル分割

マナ - 19/6/25(火) 22:31 -


	引用なし

	パスワード

▼ころんさん：

これでは、だめなんですよね。
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=869;id=word

>ファイルのページ設定やヘッダーやフッターを維持して、ファイルを指定するページ毎に分割したいと考えています。

１）文書を複製して
２）不要なページを削除
３）名前をつけて保存

これの繰り返しでできませんか。
ページ番号とかが維持されないような気がしますが・・・

　

・ツリー全体表示


	【883】ファイル分割

ころん - 19/6/24(月) 2:09 -


	引用なし

	パスワード

ファイルのページ設定やヘッダーやフッターを維持して、ファイルを指定するページ毎に分割したいと考えています。
ファイルのセクションごとに分割できるコードを見つけたのですが、これを指定するページ毎に分割できるようにするにはどうしたらよいのかご教示いただけないでしょうか。

Sub ファイル分割()
Dim doc As Document
Dim newDoc As Document
Dim i As Long, j As Long
Set doc = ActiveDocument
doc.SaveAs2 doc.Path & "\" & "ファイル名.docx"
For i = 1 To doc.Sections.Count
Set newDoc = Application.Documents.Add(Template:=doc.Path & "\" & "ファイル名.docx")
For j = doc.Sections.Count To 1 Step -1
If j <> i Then newDoc.Sections(j).Range.Delete
Next
newDoc.SaveAs2 doc.Path & "\" & "ファイル名_" & i & ".docx"
newDoc.Close
Next
End Sub

・ツリー全体表示


	【882】Re:VBAでできること／できないこと

すちぶろん - 19/6/14(金) 6:51 -


	引用なし

	パスワード

▼マナさん：

できることの見立てと、
単語をカウントする関数まで、
ご教示ありがとうございます。

やりたいことがVBAでできそうということで、
いただいた関数をヒントに
勉強を進めてみます！

本当にありがとうございます。

＞でも、コンピューターのほうは「あいまい検索」で、
＞１個ずつ確認しながら置換ではだめなのでしょうか。

おっしゃるとおり、今はいろいろな検索や
表記ゆれチェック機能などを使いながら、
Word書類を校閲しています。

例では「よろしく」「コンピューター」の２組を挙げましたが、
実際には、２５組ほどの単語を、
毎日５～１０通の書類でチェックしていまして、
少しでも簡略化できればなぁ、と思っている次第です。

質問させていただき、VBAに前向きになれました。
重ねてお礼申し上げます。ありがとうございます！

・ツリー全体表示


	【881】Re:VBAでできること／できないこと

マナ - 19/6/13(木) 21:52 -


	引用なし

	パスワード

▼すちぶろんさん：

単語をカウントする関数です。

Sub test()
　　Dim txt As String
　　Dim n1 As Long
　　Dim n2 As Long
　　
　　txt = ActiveDocument.Range.Text
　　
　　n1 = CountWord(txt, "コンピュータ")
　　n2 = CountWord(txt, "コンピューター")
　　
　　MsgBox n1 - n2
　　
End Sub

Function CountWord(txt As String, wd As String) As Long
　　Dim s
　　
　　s = Split(txt, wd)
　　CountWord = UBound(s)
　　
End Function

・ツリー全体表示


	【880】Re:VBAでできること／できないこと

マナ - 19/6/13(木) 17:46 -


	引用なし

	パスワード

▼すちぶろんさん：
￥
>できること／できないことを教えていただけると嬉しいです。

>
>(1) 最低限の目標

できると思います。

>(2) できれば行いたい目標

できると思います。

>(3) 理想的な目標

できると思います。
でも、コンピューターのほうは「あいまい検索」で、
１個ずつ確認しながら置換ではだめなのでしょうか。

・ツリー全体表示


	【879】VBAでできること／できないこと

すちぶろん - 19/6/13(木) 0:38 -


	引用なし

	パスワード

お世話になります。VBA未経験なのですが、
Wordで頻繁に行っている表記ゆれの統一作業を簡素化したく、
勉強を始めようと思っています。

次の(1)(2)(3)の各目標は、
WordやExcelでマクロできるのでしょうか。

できること／できないことを教えていただけると嬉しいです。
よろしくお願いいたします。

(1) 最低限の目標

・Wordファイルの文章から
　事前に登録した複数の単語を自動カウントし、
　カウントの少ない単語を、多い単語に自動置換する。
　置換結果が分かるよう、変更履歴を付けたい。

・例えば、次の４単語を登録します。
　「よろしく」「宜しく」
　「コンピューター」「コンピュータ」

　文章中の「よろしく」と「宜しく」を自動カウントし、
　「よろしく」が15個で、「宜しく」が7個だった場合、
　少ないほうの「宜しく」を「よろしく」に自動で置換。

　同時に「コンピューター」と「コンピュータ」も
　自動カウントし、同様の置換処理をさせる。

(2) できれば行いたい目標

・上記(1)に加えて、４単語のカウント結果
　（文章中に何回使われていたか）を数字で表示する。

・例えば、次のような表示を出せるか。
　　「よろしく」　　　15個
　　「宜しく」　　　　 7個
　　「コンピューター」 6個
　　「コンピュータ」　12個

(3) 理想的な目標

・上記(1)のように少ないほうを置換すると決めつけずに、
　上記(2)のカウント結果を見たうえで、
　どちらの用語を置換させるか選択できるようにする。

・例えば、(2)のカウント結果を見たうえで、
　前者については、
　数の少ない「宜しく」から「よろしく」に置換させ、
　後者については、
　数の多い「コンピュータ」から
　「コンピューター」に置換させるよう選択する。

・ツリー全体表示


	【878】Re:検索文字の後ろに文字挿入

マナ - 19/6/11(火) 22:30 -


	引用なし

	パスワード

▼あおぎんこさん：

１つのword文書で、挿入は１回だけですよね。

Sub test()
　　Dim r As Range
　　
　　Set r = ActiveDocument.Range
　　
　　With r.Find
　　　　.Text = "検索文字"
　　　　If .Execute Then
　　　　　　r.InsertAfter "挿入文字"
　　　　End If
　　End With

End Sub

・ツリー全体表示


	【877】検索文字の後ろに文字挿入

あおぎんこ - 19/6/11(火) 17:12 -


	引用なし

	パスワード

いつも参考にさせていただいています。

名簿（エクセル）を元に、各種Wordファイルに名簿の名入りの
Wordファイルを作る必要があるため、差込印刷ではなくマクロ
で何とかしようと四苦八苦しております。

各Wordファイルには「氏名」項目が必ずあるため、その後ろに
名前を入れてファイル保存していければと考え、具体的には次
の1.～5.の処理を行いたいと思っています。

1.エクセルファイル（名簿）を開き、名簿シートの「名前」列
を空白になるまでLooPし「名前」を順に取得
2.ダイアログでWordファイルを選択
3.開いたWordファイルで検索文字列「氏名」を検索
4.ヒットしたら、その後ろに1.の名前を入力
5.ファイルに名前をつけて保存
～空白になるまで繰り返し、終了

1.2.5.はできているのですが、3.で検索した後に4.の名前挿入の
ところで足踏みしております。
webで検索しながらひとつずつやっている状況ですが、

ヒットしたときにどういうコードを書けば、希望の処理ができる
のか、調べてもよくわからず・・。

ヒントだけでも構いませんので、どなたかご教示をよろしくお願い
いたします。

Sub サンプル()

Dim strFile As String
Dim wrdApp As Object
Dim wrdDoc As Object
Dim wrdRng As Object
　　
　strFile = "ダイアログで選択したWordファイルのフルパス"
　　　　
　Set wrdApp = CreateObject("Word.Application")’ワードを開く
　wrdApp.Visible = True
　Set wrdDoc = wrdApp.Documents.Open(strFile)　'指定のワードファイルを開く
　　wrdDoc.Range.WholeStory
　　　　With wrdDoc.Range.Find
　　　　　　　.Text = "氏名"
　　　　　　　.ClearFormatting
　　　　　　　Do While .Execute　　　　　　
　　　　　　　’★検索でヒットしたときの処理★
　　　　　　　　
　　　　　　　Loop　
　　　　End With
　　
　'～ファイル保存処理～
　
　　
End Sub

・ツリー全体表示


	【876】Re:ファイル分割

あおぎんこ - 19/5/8(水) 14:38 -


	引用なし

	パスワード

▼マナさん：

すっかり遅くなってすみません。
ご教示ありがとうございます。
ご提示いただいたコードを試してみたところ、ばっちりできました。

ファイル分割のあとなので　変数rを使用しなくてもうまくいきました。
でも.Duplicateで複製する方法があるのですね。勉強になりました。

それと　s = r.Cells(1).Next.Range.Textで次のセルのテキストを取得
したときに *が末尾に入ることや、*が2文字となることも今回勉強にな
りました。

今回分割したファイルを配布し、また回収して1つのファイルに結合する
予定です。
こちらは今コードを書いている途中です。
自力で頑張りますが、つまづいたときにはまた質問をさせてください。
どうぞよろしくお願いいたします。

>こんな感じでできると思います。
>
>Sub test()
>　　Dim myPage As Range
>　　Dim r As Range
>　　Dim s As String
>
>　　Set myPage = ActiveDocument.Range
>　　Set r = myPage.Duplicate
>
>　　With r.Find
>　　　　.Text = "番号"
>　　　　If .Execute Then
>　　　　　　If r.Information(wdWithInTable) Then
>　　　　　　　　s = r.Cells(1).Next.Range.Text
>　　　　　　　　s = Left(s, Len(s) - 2)
>　　　　　　End If
>　　　　End If
>　　End With
>
>　　MsgBox s
>
>　　myPage.Select
>
>End Sub
>
>
>この操作が、ファイル分割の後で
>myPage の範囲が変わってもよいのであれば
>変数 r を使う必要ないです。

・ツリー全体表示


	【875】Re:ファイル分割

マナ - 19/4/26(金) 18:06 -


	引用なし

	パスワード

▼あおぎんこさん：

こんな感じでできると思います。

Sub test()
　　Dim myPage As Range
　　Dim r As Range
　　Dim s As String

　　Set myPage = ActiveDocument.Range
　　Set r = myPage.Duplicate

　　With r.Find
　　　　.Text = "番号"
　　　　If .Execute Then
　　　　　　If r.Information(wdWithInTable) Then
　　　　　　　　s = r.Cells(1).Next.Range.Text
　　　　　　　　s = Left(s, Len(s) - 2)
　　　　　　End If
　　　　End If
　　End With

　　MsgBox s

　　myPage.Select

End Sub

この操作が、ファイル分割の後で
myPage の範囲が変わってもよいのであれば
変数 r を使う必要ないです。

　　

・ツリー全体表示


	【874】Re:ファイル分割

あおぎんこ - 19/4/26(金) 12:07 -


	引用なし

	パスワード

▼マナさん：

さっそく追加質問をさせてください。

ファイルを保存するときに、分割元ファイルにある文字をファイル名にしたいと考えています。

使用したい文字の位置は一定ではないのですが、必ず「番号」という文字があるセルの次のセルに入っているので、
「番号」を検索し、右に一つタブ移動し取得した文字列をファイル名の変数に格納という方法で何とか取得できないかと考えているのですが
検索はできるのですが、見つかった個所を選択するというのができずにいます。

myPage内に必ず1つ「番号」はあるので、myPageの範囲確定後に
検索文字列を赤で表示するコードを参考に下記のように記述しています。

with myPage.Find
.text="番号"
Do While .Execute
myPage.HighlightColorIndex= wdRed
Loop
End With

これで赤く表示されるのですが、カーソルは動いていないので、
検索文字列に一つ右というのがうまくいきません。
検索文字にカーソルを持っていきたいのですが、方法がよくわかりません。
myPage.HighlightColorIndex= wdRed　をどのように変えたらいいのか。。
検索文字にカーソルが移動できたら、
その後は
Selection.MoveRight Unit:=wdCell
で右に一つカーソル移動し
その文字列をコピーすればいいのかなと思っております。（ここはまだコードを思いついていませんがなんとか）

もしくはファイル名をうまく取得できる方法がほかにありましたら、ご教示いただけると幸いです。

よろしくお願いいたします。

・ツリー全体表示


	【873】Re:ファイル分割

あおぎんこ - 19/4/26(金) 9:14 -


	引用なし

	パスワード

▼マナさん：
さっそくのご回答ありがとうございます。

>これだとどうなりますか
>Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=myPage

これだときちんと2ページずつ選択できました！

>
>動作確認のために、ほとんど同じですが、書き換えてみました。
>

そして書き換えてくださったコード。
同じようにしっかり分割できました！

今はレイアウトが違うので、新規ファイルは3ページになったりしてますけど、無事に2ページずつ分割できました。
これでページレイアウトを設定して、１ファイルずつ任意の名前をつけて保存できるように、コードを加えていきたいと思います。

またわからなくなったら質問させてください。

ありがとうございました。

・ツリー全体表示


	【872】Re:ファイル分割

マナ - 19/4/25(木) 21:31 -


	引用なし

	パスワード

▼あおぎんこさん：

これだとどうなりますか
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=myPage

動作確認のために、ほとんど同じですが、書き換えてみました。

Sub test()
　　Dim mySplit As Long
　　Dim doc As Document
　　Dim myTotalPage As Long
　　Dim myPage As Range
　　Dim r As Range
　　Dim k As Long

　　mySplit = 2

　　Set doc = ActiveDocument
　　
　　myTotalPage = doc.Range.Information(wdNumberOfPagesInDocument)

　　Set myPage = doc.Range(0, 0)
　　Set r = myPage
　　
　　k = 0

　　Do Until k > myTotalPage
　　　　k = k + mySplit
　　　　myPage.Start = r.End
　　　　If k >= myTotalPage Then
　　　　　　myPage.End = doc.Range.End
　　　　Else
　　　　　　Set r = r.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=k + 1)
　　　　　　myPage.End = r.Start - 1
　　　　End If
　　　　myPage.Copy
　　　　Documents.Add.Range.Paste
　　Loop

End Sub

・ツリー全体表示


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

2 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free