Word VBA質問箱 IV

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

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


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

6 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【818】初心者です

Ka-sa

- 17/2/28(火) 10:16 -


	引用なし

	パスワード

はじめまして。Ka-saです
今回初めてwordでマクロ作成しようと思っているのですが、
こういう風な仕様にしたい！という漠然としたイメージは出来ていますが
いざ組もうと思ったら全く出来ませんでした。
それでこの質問板見つけたので質問させていただきます。

自分は今、問題を作成しています。問題は1-100問あり１問１ページにしたいです。

問題は

1　○○のとき××。△△のとき□□はどうなるか。
1.　○
2.　×
3.　△
4.　▲
5.　●
改行
改行
改行

2.　○○のとき××。△△のとき□□はどうなるか。
1.　○
2.　×
3.　△
4.　▲
5.　●
改行
改行
：
：
：
という風になっておりこれが100問あります。
ファイルが全部で50近くあるのでとてもじゃないですが一つ一つやってる時間はないのでマクロでやりたいと思ってます。

どなたかおしえていただけないでしょうか？
よろしくお願いします。

・ツリー全体表示


	【817】Re:ワードでの拡張メタファイル貼付け

マナ - 17/1/13(金) 22:33 -


	引用なし

	パスワード

▼おーもりさん：

>ワードに貼り付けるところまでは出来るのですが図を選択できずその後の操作ができません。

「ホーム」ー「選択」ー「オブジェクトの選択と表示」を試してみてください

・ツリー全体表示


	【816】ワードでの拡張メタファイル貼付け

おーもり - 17/1/10(火) 7:37 -


	引用なし

	パスワード

スクリーンショットでキャプチャーした画像をワードに拡張メタファイルで張り付けたいです。
手動ではワード上にペーストで貼付け、一度図を選択してカット、形式を選択して拡張メタファイルで張り付けるという作業をしております。
これをマクロで行うことは可能でしょうか？
ワードに貼り付けるところまでは出来るのですが図を選択できずその後の操作ができません。

よろしくお願いします。
（ワード：2010を使用）

・ツリー全体表示


	【815】Re:Word VBAで指定個所に下線

マナ - 16/10/30(日) 14:01 -


	引用なし

	パスワード

シンプルでわかりやすいし、今の方法がよいのでは
というのが、わたしの考えです。

ということで、ほとんど同じですが、
置換を一括で行うように書き換えただけの案を提示。

Sub 下線を引く2()
　　Dim r As Range
　　Dim myKW As String
　　Dim myKW2 As String

　　myKW = "<★*^13"
　　myKW2 = "<★*□"

　　Set r = ActiveDocument.Range
　
　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　.Replacement.Font.Underline = wdUnderlineThick
　　　　.Execute Replace:=wdReplaceAll
　　　　.Text = myKW2
　　　　.Replacement.Font.Underline = wdUnderlineNone
　　　　.Execute Replace:=wdReplaceAll
　　End With
　　
End Sub

該当箇所のみ下線を引こうとすると
コードがわかりにくくなるしメリットないような気がします。

Sub 下線を引く3()
　　Dim r As Range
　　Dim myKW As String

　　myKW = "□*^13"

　　Set r = ActiveDocument.Range

　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　Do While .Execute
　　　　　　If r.Paragraphs(1).Range.Characters(1) = "★" Then
　　　　　　　　r.MoveStart wdCharacter
　　　　　　　　r.Underline = wdUnderlineThick
　　　　　　End If
　　　　　　r.Collapse wdCollapseEnd
　　　　Loop

　　End With

End Sub

Sub 下線を引く4()
　　Dim r As Range
　　Dim myKW As String, repWd As String
　　Dim myKW2 As String, repWd2 As String

　　myKW = "<(★*□)(*)^13"
　　repWd = "\1〒\2〒^p"
　　
　　myKW2 = "〒(*)〒"
　　repWd2 = "\1"

　　Set r = ActiveDocument.Range
　
　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　.Replacement.Text = repWd
　　　　.Execute Replace:=wdReplaceAll
　　　　.Text = myKW2
　　　　.Replacement.Text = repWd2
　　　　.Replacement.Font.Underline = wdUnderlineThick
　　　　.Execute Replace:=wdReplaceAll
　　End With
　　
End Sub

・ツリー全体表示


	【814】Word VBAで指定個所に下線

マナ - 16/10/30(日) 13:14 -


	引用なし

	パスワード

よその掲示板であったWordに関する質問です。
向こうはExcel VBAの掲示板なので、
Excelと関係ないWordのやりとりすることに
抵抗がありましたので、この場をお借りまします。

Word VBAで指定個所に下線
excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=178971&rev=0

質問はこんな感じ：
１）段落が★で始まるとき、
２）□の次の文字から段落末（改行）まで
３）下線を引く

下記のマクロでは、一度下線を引いてから、
不要箇所の下線をけしているので無駄に思える。
最初から、目的の箇所のみに下線を引きたい。

ちょっと編集していますが、
概ねこんな内容の質問です。

Sub 下線を引く1()
　　Dim r As Range
　　Dim myKW As String
　　Dim myKW2 As String

　　myKW = "<★*^13"
　　myKW2 = "<★*□"

　　Set r = ActiveDocument.Range(0, 0)
　
　　With r.Find
　　　　.Text = myKW
　　　　.MatchWildcards = True
　　End With
　　With r
　　　　Do While .Find.Execute = True
　　　　　　.Underline = wdUnderlineThick '太下線
　　　　　　.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With
　　
　　Set r = ActiveDocument.Range(0, 0)
　　
　　With r.Find
　　　　.Text = myKW2
　　　　.MatchWildcards = True
　　End With
　　With r
　　　　Do While .Find.Execute = True
　　　　　　.Underline = wdUnderlineNone '下線なし
　　　　　　.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With

End Sub

・ツリー全体表示


	【813】Re:選択範囲内の文字列検索

マナ - 16/9/10(土) 11:44 -


	引用なし

	パスワード

１行追加してみました。
出来ているような気がしています。

Sub 選択範囲内の文字列検索2()
　　Dim r As Range
　　Dim n As Long

　　Set r = Selection.Range
　　r.Collapse wdCollapseStart　'★追加
　　
　　With r.Find
　　　　.Text = "検索ワード"
　　　　Do While .Execute
　　　　　　If Not r.InRange(Selection.Range) Then Exit Do
　　　　　　n = n + 1
　　　　Loop
　　End With
　　
　　MsgBox n & "個"
　　
End Sub

・ツリー全体表示


	【812】選択範囲内の文字列検索

マナ - 16/9/10(土) 11:12 -


	引用なし

	パスワード

Word質問箱は、利用者いないから廃止
ということは、ないと思いますが。
書込みしておきます。

ht　tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=715;id=word

の続きです。
選択範囲内の文字列検索する下記マクロ

Sub 選択範囲内の文字列検索()
　　Dim r As Range
　　Dim n As Long
　　
　　Set r = Selection.Range
　　
　　With r.Find
　　　　.Text = "検索ワード"
　　　　Do While .Execute
　　　　　　If Not r.InRange(Selection.Range) Then Exit Do
　　　　　　n = n + 1
　　　　Loop
　　End With
　　
　　MsgBox n & "個"
　　
End Sub

でも、検索範囲と検索語が同じだった場合は失敗する。
０個になってしまう。

・ツリー全体表示


	【811】Re:ルビの入力設定

マナ - 15/10/10(土) 18:27 -


	引用なし

	パスワード

▼こっこさん：

設定ではできないようで、代案です。

期待のものと違うと思いますが、
↓のマクロが役立ちそうです。
ht　tp://www.ka-net.org/blog/?p=4562

・ツリー全体表示


	【810】ルビの入力設定

こっこ - 15/10/8(木) 15:46 -


	引用なし

	パスワード

通常ルビの入力はひらがな設定になっていますが「F7」を押さずにデフォルトでカタカナ入力に設定は出来ますでしょうか？

・ツリー全体表示


	【809】Re:差し込み印刷指定ありで必要枚数のコピ...

マリモ - 15/3/29(日) 9:26 -


	引用なし

	パスワード

▼マナさん：
>差し込み印刷の設定が完了しているとして、
>
>結果のプレビューで、既にお望みの状態になっていることが確認できるはず。
>その結果を印刷するか、新規文書に保存するかは選べます。
>
>マクロを使って、２００回コピペを繰り返す必要はありません。
>差し込み印刷を実行するだけです。

できました。
今後はしっかり調べてからにいたします。
ありがとうございました。

・ツリー全体表示


	【808】Re:差し込み印刷指定ありで必要枚数のコピ...

マナ - 15/3/28(土) 10:45 -


	引用なし

	パスワード

差し込み印刷の設定が完了しているとして、

結果のプレビューで、既にお望みの状態になっていることが確認できるはず。
その結果を印刷するか、新規文書に保存するかは選べます。

マクロを使って、２００回コピペを繰り返す必要はありません。
差し込み印刷を実行するだけです。

・ツリー全体表示


	【807】Re:差し込み印刷指定ありで必要枚数のコピ...

マリモ - 15/3/28(土) 9:06 -


	引用なし

	パスワード

▼マナさん：
>私のできる範囲で、お手伝いしたいのですが、
>何をしたいかが理解できていません。
ありがとうございます。

>＞A3横で２枚
>
>というのは、A3で２ページの文書ということですか？
そうです。

>＞２枚×２００、その下に続けてコピーを作りたい
>
>200件のレコードについて、差し込み印刷したいということではないのですか？
そうです。
ただ、A3横の１枚ずつに入れてあります。

>＞段落番号が続きになってしまう
>
>段落番号とは？
文章の番号書式で
問1
　１）
　２）
問２
　１）
　２）
上記のような連続になっているのですが、
３ページ以降がその続きになってしまっていて
同じものをそのままコピーをしたいのです。

説明が下手なので伝わりにくくて申し訳ございませんが
よろしくお願いいたします。

・ツリー全体表示


	【806】Re:差し込み印刷指定ありで必要枚数のコピ...

マナ - 15/3/27(金) 20:57 -


	引用なし

	パスワード

私のできる範囲で、お手伝いしたいのですが、
何をしたいかが理解できていません。

＞A3横で２枚

というのは、A3で２ページの文書ということですか？

＞２枚×２００、その下に続けてコピーを作りたい

200件のレコードについて、差し込み印刷したいということではないのですか？

＞段落番号が続きになってしまう

段落番号とは？

・ツリー全体表示


	【805】Re:差し込み印刷指定ありで必要枚数のコピ...

マリモ - 15/3/26(木) 13:55 -


	引用なし

	パスワード

Sub docTest_copy4()
　　Dim Range2 As Range
　　Selection.WholeStory
　　If Selection.Type <> wdSelectionIP Then
　　　　Selection.Copy
　　　　Set Range2 = ActiveDocument.Content
　　　　Range2.Collapse Direction:=wdCollapseEnd
　　　　Range2.Paste
　　End If
End Sub

この貼付作業を200回繰り返すのと
段落番号が続きになってしまうので
貼り付けの際に段落番号がリセットされるようにしたいのですが
上手く組み込めません。

お力添えをお願いいたします。

・ツリー全体表示


	【804】差し込み印刷指定ありで必要枚数のコピーに...

マリモ - 15/3/25(水) 14:09 -


	引用なし

	パスワード

はじめまして。
word vbaは初めてなので、よろしくお願いいたします。

A3横で２枚ありまして、その２枚に差し込みフィールドの挿入をしてあります。
２枚×２００、その下に続けてコピーを作りたいのですが、
テキストボックスや表も含まれております。

手作業ではなく、
何か、いい方法はないでしょうか。

・ツリー全体表示


	【803】Re:ブックマークのテキストを更新すると、...

マナ - 15/2/26(木) 23:39 -


	引用なし

	パスワード

ということで、ちょっと検索してみました

Inserting text at a bookmark without deleting the bookmark
ht tp://word.mvps.org/faqs/macrosvba/InsertingTextAtBookmark.htm

向こうで、脱線した話も迷惑でしょうし、誰も見てないようなのでこちらに。

・ツリー全体表示


	【802】ブックマークのテキストを更新すると、ブッ...

マナ - 15/2/26(木) 23:31 -


	引用なし

	パスワード

お隣の板で回答していた気づいたこと。
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=76671;id=excel

>転記するとブックマークが削除されてしまう。
>書き方が間違っているのか？？？
>
>doc.bookmarks("好きな名前").Range.Text = c.Value

・ツリー全体表示


	【801】Re:使いかけラベルシートに差込印刷

マナ - 15/2/21(土) 22:24 -


	引用なし

	パスワード

>こんな感じで、何個の空レコードを差込対象とするかどうかを
>マクロで設定しようと試みたのですが、なぜか駄目でした？？

完全な空レコードでなければ設定できるみたい。

・ツリー全体表示


	【800】Re:使いかけラベルシートに差込印刷

マナ - 15/2/17(火) 21:13 -


	引用なし

	パスワード

使用済み枚数（空レコード数）の計算部分は
こっちのほうがよかったかも。

　　With doc.MailMerge
　　　　With .DataSource
　　　　　　'使用済み枚数（空レコード数）の計算
　　　　　　.ActiveRecord = wdFirstRecord
　　　　　　Do While .ActiveRecord < cnt
　　　　　　　　If .Included Then n1 = n1 + 1
　　　　　　　　.ActiveRecord = wdNextRecord
　　　　　　Loop

>　　
>　　With doc.MailMerge
>　　　　With .DataSource
>　　　　　　'使用済み枚数（空レコード数）の計算
>　　　　　　.ActiveRecord = wdFirstDataSourceRecord
>　　　　　　For i = 1 To cnt - 1
>　　　　　　　　If .Included Then n1 = n1 + 1
>　　　　　　　　.ActiveRecord = wdNextDataSourceRecord
>　　　　　　Next
>

>

・ツリー全体表示


	【799】Re:使いかけラベルシートに差込印刷

マナ - 15/2/16(月) 23:21 -


	引用なし

	パスワード

こんな感じで、何個の空レコードを差込対象とするかどうかを
マクロで設定しようと試みたのですが、なぜか駄目でした？？

Sub test失敗()
　　Dim n As String, i As Long
　　
　　n = InputBox("使用済みラベル数入力")
　　If n = "" Then Exit Sub
　　If Not IsNumeric(n) Then Exit Sub
　　
　　With ActiveDocument.MailMerge.DataSource
　　　　.ActiveRecord = wdFirstDataSourceRecord
　　　　For i = 1 To 7
　　　　　　 If i <= CLng(n) Then
　　　　　　　　.Included = True
　　　　　　Else
　　　　　　　　.Included = False
　　　　　　End If
　　　　　　.ActiveRecord = wdNextDataSourceRecord
　　　　Next
　　End With

End Sub

　

・ツリー全体表示


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

6 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free