Word VBA質問箱 IV

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

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


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

9 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【757】Re:Wordに挿入したExcelｼｰﾄ内のﾃﾞｰﾀの取得

マナ - 13/5/8(水) 21:10 -


	引用なし

	パスワード

>結局、WordVBAでExcelｼｰﾄのｾﾙのﾃﾞｰﾀを取得することはできそうもないようです。

ちょっと調べながらやってみました。こんな感じできそうです。

>1.Wordで『Excelｼｰﾄの挿入』ﾎﾞﾀﾝでExcelｼｰﾄを挿入後、WordVBAでExcelｼｰﾄのｾﾙのﾃﾞｰﾀを取得する方法を教えて下さい。
>2.WordVBAでExcelｼｰﾄのｾﾙにﾃﾞｰﾀを入力する方法はあるのでしょうか。
>以上よろしくお願い」します。。
Sub test()　'挿入したエクセルを選択して実行
　　Dim myOle As Word.OLEFormat
　　Dim xlApp As Excel.Application
　　Dim myStr As String

　　With Selection
　　　　If .Type <> wdSelectionShape And _
　　　　　　.Type <> wdSelectionInlineShape Then Exit Sub
　　　　Select Case .Type
　　　　　　Case wdSelectionShape
　　　　　　　　If .ShapeRange(1).Type <> msoEmbeddedOLEObject Then Exit Sub
　　　　　　　　Set myOle = .ShapeRange(1).OLEFormat
　　　　　　Case wdSelectionInlineShape
　　　　　　　　If .InlineShapes(1).Type <> wdInlineShapeEmbeddedOLEObject Then Exit Sub
　　　　　　　　Set myOle = .InlineShapes(1).OLEFormat
　　　　End Select
　　End With
　　
　　With myOle
　　　　If Not .ClassType Like "Excel.Sheet*" Then Exit Sub
　　　　.DoVerb VerbIndex:=wdOLEVerbOpen
　　　　With .Object
　　　　　　Set xlApp = .Application
　　　　　　myStr = .Sheets("Sheet1").Range("A1").Value　'★Excelｼｰﾄのｾﾙのﾃﾞｰﾀを取得
　　　　　　.Sheets("Sheet1").Range("A1").Value = "test入力"　'★Excelｼｰﾄのｾﾙにﾃﾞｰﾀを入力
　　　　　　.Close
　　　　　　xlApp.Quit
　　　　End With
　　End With
　　
　　MsgBox myStr
　　
　　Set xlApp = Nothing

End Sub

・ツリー全体表示


	【756】Re:複数ファイルの特定のページだけを印刷...

マナ - 13/5/6(月) 11:15 -


	引用なし

	パスワード

今更ですが。ヘルプで調べてみました。

エクセルとは、ちょっと違うのですね。
勉強になりました。

Sub test()
　　Dim d As Document
　　
　　For Each d In Documents
　　　　d.PrintOut Range:=wdPrintFromTo, From:="3", To:="3"
　　Next
End Sub

・ツリー全体表示


	【755】Re:特定見出しのすぐ下の表を選択するには?

マナ - 13/5/6(月) 10:51 -


	引用なし

	パスワード

今更ですが、自分の勉強として書いてみました。

Sub test()
　　Dim myPara As Paragraph
　　
　　For Each myPara In ActiveDocument.Paragraphs
　　　　If myPara.Style = "見出し 1" Then
　　　　　　If InStr(myPara.Range.Text, "AAA") > 0 Then
　　　　　　　　myPara.Range.Select
　　　　　　　　Selection.GoTo What:=wdGoToTable, which:=wdGoToNext
　　　　　　　　If Selection.Information(wdWithInTable) Then
　　　　　　　　　　Selection.Tables(1).Select
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　Next myPara
　　
End Sub

・ツリー全体表示


	【754】Re:Word VBAを用いたファイル分割及び結合...

マナ - 13/5/6(月) 10:06 -


	引用なし

	パスワード

回答がつかず、今更ですが、自分の勉強として書いてみました。

直接、新規ファイルに抽出しています。

キーワードに挟まれた部分にブックマークをつけ
エクセルA列セルの値の順番通りに、コピペです。

Sub test()
　　Dim myDoc As Document
　　Dim b As Bookmark
　　Dim myRng As Range
　　Dim n As Long
　　Const myKey1 As String = "【はじめ】"
　　Const myKey2 As String = "【おわり】"

　　Set myDoc = ActiveDocument
　　
　　Set myRng = myDoc.Range(0, 0)
　　With myRng.Find
　　　　.Text = myKey1 & "*" & myKey2
　　　　.MatchWildcards = True
　　　　Do While .Execute
　　　　　　n = n + 1
　　　　　　myRng.Bookmarks.Add Name:="BM" & n
　　　　Loop
　　End With
　　

　　Dim xlApp As New Excel.Application
　　Dim myBook As Excel.Workbook
　　Dim c As Excel.Range
　　Dim s As String

　　xlApp.Visible = True
　　Set myBook = xlApp.Workbooks.Open("C:\****\****\****.xls")

　　Application.Documents.Add
　　
　　With myBook.worksheets("Sheet1")
　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　　　　　If myDoc.Bookmarks.Exists(c.Value) Then
　　　　　　　　myDoc.Bookmarks(c.Value).Range.Copy
　　　　　　　　Selection.Paste
　　　　　　　　Selection.TypeParagraph
　　　　　　End If
　　　　Next
　　　　For Each b In ActiveDocument.Bookmarks
　　　　　　b.Delete
　　　　Next
　　End With
　　myBook.Close False
　　xlApp.Quit
　　Set myBook = Nothing
　　Set xlApp = Nothing
　　
　　For Each b In myDoc.Bookmarks
　　　　b.Delete
　　Next

End Sub

・ツリー全体表示


	【753】Re:文字検索

マナ - 13/5/5(日) 10:55 -


	引用なし

	パスワード

>>今組んでいるマクロでは、選択範囲は無視されて、ドキュメントの最後まで検索してしまいます。
>
>ですが、私の環境では、ゆいさんが最初に提示されたマクロで、
>選択範囲のみの検索になっているみたいです。

>それとも私は何か勘違いしてるのかしら。

もしかするとわかったような気がします。

ht tp://www.ka-net.org/blog/?p=1199
リンク先のように、検索を繰り返す場合の問題なのかもしれませんね。
確かに、マクロを使う場合は、単純な検索・置換でなく、
検索しながら、何らかの処理を繰り返し、
といった場合のほうが、多いと思いますので。

つまり、ゆいさんの提示されたコードは、
もう一つのほうの位置取得の質問のためのものだったと。

以前書いた検索を使ったコードを探してみました。
全然覚えていませんでしたが、
自分ではこんな感じにしていたものがありました。

Set myRng = Selection.Range

With myRng.Find
　　.Text = "■■"　　　　　　　　　　
　　Do While .Execute
　　　　If myRng.End > Selection.End Then Exit Do
　　　　'ここで処理実行
　　 Loop
End With

でも今試してみたら、リンク先のInRange（知りませんでした）を使った方法と同じで、検索範囲と検索語が同じだった場合は、期待通りになりませんでした。
それがわかったことと、InRangeの存在を知ったのは収穫です。

H. C. Shinopyさんの
>Ifステートメントで範囲内かどうか判断しながら処理する方法はありますが、

これは、InRangeを使う方法のことだったのかも知れませんね。

というわけで、私の便乗質問については、何とか納得（解決）です。

・ツリー全体表示


	【752】Re:文字を挿入する

マナ - 13/5/3(金) 20:42 -


	引用なし

	パスワード

今更ですが。これも自分の勉強として書いてみました。

Sub test()
　　Dim cnt As Long
　　Dim myRng As Range
　　
　　ActiveDocument.Range(0, 0).Select
　　Set myRng = Selection.Range

　　Do
　　　　cnt = cnt + 1
　　　　Selection.TypeText Text:="save" & cnt & "|save"
　　　　Selection.TypeParagraph
　　　　Selection.MoveDown Unit:=wdLine, Count:=1
　　　　Selection.EndKey
　　　　myRng.SetRange Selection.Start, Selection.End
　　　　Selection.MoveDown Unit:=wdLine, Count:=1
　　　　Selection.HomeKey
　　Loop While ActiveDocument.Range.End - 1 <> myRng.End

End Sub

・ツリー全体表示


	【751】Re:ｗｏｒｄ　ＶＢＡ　カーソル位置について

マナ - 13/5/3(金) 20:25 -


	引用なし

	パスワード

私もなかなか覚えられません。いつもここみて確認しています。
（質問者さんは当然もうみてないだろうけど、自分の勉強のために。）

ht tp://hanatyan.sakura.ne.jp/vbhlp/wordref1.htm

Sub test1()
　　'５ページ目に移動
　　Selection.GoTo What:=wdGoToPage, Count:=5
　　 '２行下（３行目）に移動
　　Selection.Move Unit:=wdLine, Count:=2
'　　５文字右に移動
　　Selection.Move Unit:=wdCharacter, Count:=5
'　　３文字右に移動したところまで選択
　　Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend

End Sub

Sub test2()
　　Selection.HomeKey Unit:=wdLine　'Home
　　Selection.TypeText "行頭"
　　Selection.EndKey Unit:=wdStory　'Ctrl+End
　　Selection.TypeText "最後"
End Sub

・ツリー全体表示


	【750】Re:ページ全体の移動

マナ - 13/5/3(金) 13:32 -


	引用なし

	パスワード

>特定ページの先頭位置あるいは先頭文字
>　　　　　　最後位置あるいは最後文字　　の取得
>
>あるいは特定ページのページ番号の　取得
>
>は可能でしょうか。

↑については、こんな感じで。
カーソルの移動関係は必須なのに、すぐに忘れちゃうので、
いつも、こちらを参考にしています。今回も。
ht tp://hanatyan.sakura.ne.jp/vbhlp/wordref1.htm

Sub test()
　　Dim p As String　　 '指定のページ
　　Dim e As Long　　　 '最終のページ
　　Dim c As Long　　　 '現在のページ
　　Dim msg As String
　　
　　e = Selection.Information(wdNumberOfPagesInDocument)
　　msg = "ページ番号（1～" & e & "）を入力してください。"
　　
　　c = Selection.Information(wdActiveEndPageNumber)
　　Do
　　　　p = InputBox(Prompt:=msg, Default:=c)
　　　　If p = "" Then Exit Sub
　　　　If IsNumeric(p) Then
　　　　　　p = CLng(p)
　　　　　　If p > e Then
　　　　　　　　MsgBox "そんなにページはありません"
　　　　　　Else
　　　　　　　　Exit Do
　　　　　　End If
　　　　Else
　　　　　　MsgBox "数字のみ入力可です"
　　　　End If
　　Loop
　　
　　Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=p

　　MsgBox "ページ:" & Selection.Information(wdActiveEndPageNumber) & vbCrLf & _
　　　　　　"先頭位置：" & Selection.Start & vbCrLf & _
　　　　　　"先頭文字：" & Selection.Text
　　
　　If e > p Then
　　　　Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
　　Else
　　　　Selection.Move Unit:=wdStory
　　End If
　　Selection.MoveLeft

　　MsgBox "ページ:" & Selection.Information(wdActiveEndPageNumber) & vbCrLf & _
　　　　　　"最後位置：" & Selection.Start & vbCrLf & _
　　　　　　"最後文字：" & Selection.Text
　　
End Sub

・ツリー全体表示


	【749】Re:段落について

ひかる - 13/5/3(金) 9:51 -


	引用なし

	パスワード

ご回答いただきありがとうございました。
方法がわからず停滞しているところでした。
実践してみようと思います。
本当にありがとうございました。

・ツリー全体表示


	【748】Re:ページ全体の移動

マナ - 13/5/2(木) 21:55 -


	引用なし

	パスワード

もう見てないでしょうが。自分の勉強のために書いてみました。

>換言すれば、ＷＯＲＤ　ＶＢＡで　ＥＸＣＥＬ　ＶＢＡ
>
>のようにページ管理が可能でしょうか。

ＥＸＣＥＬ　ＶＢＡのようにの意味がわかりませんが、
１ページ目を４ページ目の前に移動させる例です。
ちゃんと出来てるのかなぁ。あまり自信ありません。

Sub test()
　　Dim s As Long
　　Dim e As Long
　　
　　Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=4
　　ActiveDocument.Bookmarks.Add Name:="移動先"
　　
　　Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=1
　　s = Selection.Range.Start
　　Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=2
　　e = Selection.Range.Start

　　If e > s Then
　　　　ActiveDocument.Range(s, e).Cut
　　　　ActiveDocument.Bookmarks("移動先").Range.Paste
　　End If
　　
　　ActiveDocument.Bookmarks("移動先").Delete

End Sub

・ツリー全体表示


	【747】Re:Excel VBAからのWord置換

マナ - 13/5/2(木) 17:11 -


	引用なし

	パスワード

今更必要ないと思いますが、自分の勉強のために確認してみましたので報告です。

私の環境は、win7、word2010ですが、問題なく動作しました。

・ツリー全体表示


	【746】Re:頁(目）および行(目）の取得

マナ - 13/5/2(木) 15:18 -


	引用なし

	パスワード

今更でもう解決しているかもしれませんが。
自分の勉強を兼ねて確認してみました。

>ExcelのVBA ProjectからWordを操作して
>
>（定義したWorkbook）.Sheet(i)Cells(m,n).value = Selection.Information(wdActiveEndPageNumber)

↑この時の、SelectionはExcel側なのではないかと思います。

こんな感じにすればうまくいくようです。

Sub test()
　　Const myName As String = "D:\***\****\るりさま.doc"
　　Dim myDoc As Object
　　
　　With CreateObject("Word.Application")
　　　　Set myDoc = .Documents.Open(myName)
　　　　.Visible = True
　　　　myDoc.Characters(500).Select
　　　　Range("A1").Value = .Selection.Information(3)　 'wdActiveEndPageNumber
　　　　Range("A2").Value = .Selection.Information(10)　'wdFirstCharacterLineNumber
　　　　myDoc.Close False
　　　　.Quit
　　End With

End Sub

・ツリー全体表示


	【745】Re:漢字あるいはカタカナからなる文字列の...

マナ - 13/5/2(木) 14:20 -


	引用なし

	パスワード

回答がつきませんでしたので、もう必要ないかもしれませんが。
自分に勉強のために。

>　　Select Case Activedocument.words(i)
>　　Case"[－-鶴]{1,}","[ァ-ヾ]{1,}","[ｦ-ﾟ]{1,}"
>
>としましたが、対象文字列を拾ってくれません。
>
>定義の仕方に問題があるのでしょうか。

Select Caseではワイルドカードは使えなかったかと思います。

Sub test()
　　Dim myRng As Range
　　Dim w As Object
　　Dim cnt As Long
　　
　　Set myRng = Selection.Range

　　With CreateObject("VBScript.RegExp")
　　　　.Pattern = "^[一-鶴]+$|^[ァ-ヾ]+$|^[ｦ-ﾟ]+$"
　　　　For Each w In myRng.Words
　　　　　　If .test(w.Text) Then
　　　　　　　　'ここで実行
　　　　　　　　Debug.Print w.Text
　　　　　　　　cnt = cnt + 1
　　　　　　End If
　　　　Next
　　End With
　　If cnt > 0 Then
　　　　MsgBox cnt & "個ありました"
　　Else
　　　　MsgBox "1個もありませんでした"
　　End If
End Sub

・ツリー全体表示


	【744】Re:Word VBA　条件が一致したら、表の指定...

マナ - 13/5/2(木) 13:43 -


	引用なし

	パスワード

mougで解決済みでしたね。速攻で回答いただけたようで、何よりです。

・ツリー全体表示


	【743】Re:文字検索

マナ - 13/5/1(水) 14:08 -


	引用なし

	パスワード

▼ゆいさん：
>アドバイス頂いた内容をきちんと理解できていませんが、
>何とか希望通りの動作をするマクロにすることが出来ました！
>ありがとうござました。
>
>アドバイス頂いたマクロの内容の勉強をこれから行います！

私も勉強中でまだまだわかっておりません。どなたか教えて下さい。
解決済みなうえに、１年以上も前なのですが、ここで便乗質問してもよいでしょうか。

ゆいさんの質問の
>今組んでいるマクロでは、選択範囲は無視されて、ドキュメントの最後まで検索してしまいます。

ですが、私の環境では、ゆいさんが最初に提示されたマクロで、
選択範囲のみの検索になっているみたいです。

>　.Wrap = wdFindStop
これでは駄目なのでしょうか？

それとも私は何か勘違いしてるのかしら。

・ツリー全体表示


	【742】Re:段落について

マナ - 13/5/1(水) 13:16 -


	引用なし

	パスワード

1文字目を確認しながら、適用する箇条書きテンプレートを選ぶように修正してみました。
このほうが応用がきくかもしれません。

Sub test2()
　　Dim t1 As ListTemplate
　　Dim p As Paragraph
　　
　　Set t1 = ListGalleries(wdNumberGallery).ListTemplates(1)
　　
　　With t1.ListLevels(1)
　　　　.NumberFormat = "%1"
　　　　.TrailingCharacter = wdTrailingTab
　　　　.NumberStyle = wdListNumberStyleArabic
　　　　.NumberPosition = MillimetersToPoints(6.6)
　　　　.Alignment = wdListLevelAlignRight
　　　　.TextPosition = MillimetersToPoints(22)
　　　　.TabPosition = MillimetersToPoints(22)
　　　　.ResetOnHigher = 0
　　　　.StartAt = 1
　　End With
　　
　　For Each p In Selection.Paragraphs
　　　　If p.Range.Characters.First = "●" Then
　　　　　　p.Range.ListFormat.ApplyListTemplate _
　　　　　　　　ListTemplate:=t1, _
　　　　　　　　ContinuePreviousList:=True
　　　　　　p.Format.TabStops.Add Position:=MillimetersToPoints(10)
　　　　ElseIf p.Range.Characters.First = "■" Then
　　　　　　p.Range.Characters.First.Delete
　　　　　　p.LeftIndent = MillimetersToPoints(22)
　　　　Else
　　　　　　p.Range.ListFormat.ApplyListTemplate _
　　　　　　　　ListTemplate:=t1, _
　　　　　　　　ContinuePreviousList:=True
　　　　End If
　　Next
End Sub

・ツリー全体表示


	【741】Re:コンテンツコントロールの値をVBAで取得...

マナ - 13/4/30(火) 10:46 -


	引用なし

	パスワード

もう見てないと思いますが
自分の勉強のため、確認してみました。

1点目：
終了日1/5/13の場合、2001年5月13日として計算されているからと思われます。

2点目：
Word2010なのですが、こちらでは再現しませんでした。
ですから問題点そのものがわかっていないかもしれませんが。

・ツリー全体表示


	*【740】Re:ワードマクロ　列3に【第()話】がある...**

マナ - 13/4/30(火) 10:24 -


	引用なし

	パスワード

さすがにもう見ていないでしょうから、
遠慮無く、ここも勉強に使わせていただきましょっと。

ところでDebug.Print strの件は？　こちらではちゃんと機能しました。

>Debug.Print str の部分は
>小さなウインドウを表示して
>そこに、変数strが表示される・・と思ったのですが
>表示されず、動作の是非の判断がつかないず

Sub test()
　　Dim tbl As Table
　　Dim r As Row
　　Dim str As String

　　With CreateObject("VBScript.RegExp")
　　　　.Pattern = ".*【第([0-9]{1,2})話】.*"
　　　　For Each tbl In ActiveDocument.Tables
　　　　　　For Each r In tbl.Rows
　　　　　　　　str = r.Cells(3).Range.Text
　　　　　　　　If .test(str) Then
　　　　　　　　　　r.Cells(6).Range.Text = .Replace(str, "$1")
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　End With
End Sub

・ツリー全体表示


	【739】Re:Word VBA　条件が一致したら、表の指定...

マナ - 13/4/29(月) 17:16 -


	引用なし

	パスワード

もう見てないと思いますが。自分の勉強のつもりで。
withも無駄なので、ついでに省略しました。

Sub 文字サイズ変更()
　　Dim myTable As Table
　　For Each myTable In ActiveDocument.Tables
　　　　If myTable.Cell(Row:=1, Column:=1).Range.Text = "○○○" & vbCr & Chr(7) Then
　　　　　　myTable.Cell(Row:=2, Column:=2).Range.Font.Size = 9.5
　　　　End If
　　Next
End Sub

・ツリー全体表示


	【738】Re:段落について

マナ - 13/4/29(月) 16:50 -


	引用なし

	パスワード

もう見てない可能性が高いでしょうが、勉強のつもりで書いてみました。
現在のマクロを実行した後に、下記でどうでしょうか。

Sub test()
　　Dim p As Paragraph
　　
　　For Each p In Selection.Paragraphs
　　　　If p.Range.ListFormat.ListString = "●" Then
　　　　　　p.Range.ListFormat.RemoveNumbers
　　　　　　p.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
　　　　　　　　wdNumberGallery).ListTemplates(1)
　　　　　　p.Format.TabStops.Add Position:=MillimetersToPoints(10)
　　　　ElseIf p.Range.ListFormat.ListString = "■" Then
　　　　　　p.Range.ListFormat.RemoveNumbers
　　　　　　p.LeftIndent = MillimetersToPoints(22)
　　　　End If
　　Next
End Sub

・ツリー全体表示


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

9 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free