Word VBA質問箱 IV

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

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


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

8 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【770】Re:Word-xml形式（2003）⇔Word（2003）自...

マナ - 13/5/22(水) 19:36 -


	引用なし

	パスワード

XML→DOCバージョン
こっちも全然自信なし

Sub test2()
　　Dim i As Long
　　Const myFld = "C:\Documents and Settings\user\デスクトップ\test2" '★

　　With Application.FileSearch
　　　　.LookIn = myFld
　　　　.FileName = "*.xml"
　　　　.SearchSubFolders = True
　　　　If .Execute Then
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　Documents.Open .FoundFiles(i)
　　　　　　'★ここから---------------マクロの記録の結果を参考に
　　　　　　　　With ActiveDocument
　　　　　　　　　　.SaveAs FileName:=Left(.FullName, Len(.FullName) - 3) & "doc", _
　　　　　　　　　　　　FileFormat:=wdFormatDocument
　　　　　　　　　　.Close
　　　　　　　　End With
　　　　　　'★ここまで--------------------
　　　　　　Next
　　　　End If
　　End With

End Sub

・ツリー全体表示


	【769】Re:Word-xml形式（2003）⇔Word（2003）自...

マナ - 13/5/22(水) 18:55 -


	引用なし

	パスワード

わからないなりに書いてみました。（全然自信なし）
DOCと同じフォルダにXMLで保存します。
時間がかかりすぎて使い物にならないかも。

DOC→XMLに変換する部分はマクロの記録を試してみてください。

私にはわからなかったこともあり、
下の例では、必要な部分も、捨ててしまったかもしれません。
適当に修正して下さい。

Sub test()
　　Dim i As Long
　　Const myFld = "C:\Documents and Settings\user\デスクトップ\test" '★実際のフォルダに

　　With Application.FileSearch
　　　　.LookIn = myFld
　　　　.FileName = "*.doc"
　　　　.SearchSubFolders = True
　　　　If .Execute Then
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　Documents.Open .FoundFiles(i)
　　　　　　'★ここから-----マクロの記録の結果を参考に修正必要
　　　　　　　　With ActiveDocument
　　　　　　　　　　.SaveAs FileName:=Left(.FullName, Len(.FullName) - 3) & "xml", _
　　　　　　　　　　　　FileFormat:=wdFormatXML
　　　　　　　　　　.Close
　　　　　　　　End With
　　　　　　'★ここまで--------------------
　　　　　　Next
　　　　End If
　　End With

End Sub

・ツリー全体表示


	【768】Re:Word-xml形式（2003）⇔Word（2003）自...

PPNNOOPP - 13/5/21(火) 22:50 -


	引用なし

	パスワード

>全くわかっていませんが、WordML形式を選んで保存でよいのでしょうか。
→その通りでございます。

フォルダ内（サブフォルダを含む）に複数のファイル（3000前後）存在しているので、VBAで処理できないか考えておりましたが、VBAの知識が乏しいもので、投稿させていただいた次第です。

どうぞよろしくお願いいたします。

・ツリー全体表示


	【767】Re:Word-xml形式（2003）⇔Word（2003）自...

マナ - 13/5/21(火) 22:27 -


	引用なし

	パスワード

全くわかっていませんが、WordML形式を選んで保存でよいのでしょうか。

１）もしそうならば、まず一つのファイルを変換する操作について「マクロの記録」を実行し、期待通り動くコードが得られるか確認してみてはでうでしょうか。

２）うまく動くようなら、それを複数ファイルに対して実行出来るようにすることを考えるとよいと思います。

・ツリー全体表示


	【766】Word-xml形式（2003）⇔Word（2003）自動変...

PPNNOOPP - 13/5/21(火) 15:07 -


	引用なし

	パスワード

お世話になっております。

Word-xml形式（2003）⇔Word（2003）変換の自動置換ツールを探しておりますが、なかなか見つからないので、VBAで自動処理できないかと思い投稿させていただきました。

やりたいことは下記のとおりです。

1.特定のフォルダ内（サブフォルダを含む）の複数のWord-xml形式（2003）ファイルをWord2003形式に変換する。

上記とは逆に
2.特定のフォルダ内（サブフォルダを含む）の複数のWord2003形式ファイルをWord-xml形式（2003）に変換する。

1.、2.それぞれ別々に処理したいので、ご検討の程よろしくお願いいたします。

・ツリー全体表示


	【765】Re:基本的なwordのＶＢＡの操作法

マナ - 13/5/19(日) 21:50 -


	引用なし

	パスワード

ここなどはどうでしょうか。

ht tp://makoto-watanabe.main.jp/WordVba.html#start
ht tp://www.beagle-hc.com/It_program/Word0.html

・ツリー全体表示


	【764】Re:セクション区切りのファイルにページを...

マナ - 13/5/19(日) 11:24 -


	引用なし

	パスワード

ときどき意図しないページが印刷されることがありましたが、これでしたか。
参考になりました。

ちなみに、マクロでは、こんな感じみたいです。

ActiveDocument.PrintOut Range:=wdPrintFromTo, From:="p5s3", To:="p2s4"
ActiveDocument.PrintOut Range:=wdPrintRangeOfPages, Pages:="p5s3-p2s4"

・ツリー全体表示


	【763】Re:Wordﾌｧｲﾙ１ページ目選択？

マナ - 13/5/19(日) 10:01 -


	引用なし

	パスワード

今更ですが、勉強のために試してみました。
こういうことでしょうか。
ActiveDocument.Bookmarks("\page").Range.Copy

>　　'一枚目、貼付頁選択、コピー
>　　Selection.MoveDown Unit:=wdLine, Count:=10, Extend:=wdExtend
>　　Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
>　　Selection.MoveDown Unit:=wdLine, Count:=27, Extend:=wdExtend
>　　Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
>　　Selection.Copy

・ツリー全体表示


	【762】Re:Word画像サイズ変更をマクロで登録したい

マナ - 13/5/19(日) 9:49 -


	引用なし

	パスワード

今更ですが、勉強のために書いてみました。

Sub test()
　　Dim myPath As String
　　Dim myFile As String

　　myPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
　　myFile = Dir(myPath & "*.jpg")
　　Do While myFile <> ""
　　　　With ActiveDocument.InlineShapes.AddPicture(myPath & myFile)
　　　　　　.LockAspectRatio = True
　　　　　　.Width = CentimetersToPoints(10)
　　　　End With
　　　　myFile = Dir()
　　　　Selection.MoveRight
　　　　Selection.TypeParagraph
　　Loop

End Sub

・ツリー全体表示


	【761】Re:選択した文字列から１文字ずつ削除する...

マナ - 13/5/19(日) 9:20 -


	引用なし

	パスワード

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

InStrだとワイルドカードが使えないので、Likeを使用しました。

Sub test()
　　Dim myStr As String
　　Dim s As String
　　Dim i As Long
　　Dim Yougo As String

　　myStr = Selection.Text
　　For i = 1 To Len(myStr)
　　　　s = Mid(myStr, i, 1)
　　　　If s Like "[A-z0-9]" Then
　　　　　　Yougo = Mid(myStr, 1, i - 1)
　　　　　　Exit For
　　　　End If
　　Next
　　If Len(Yougo) > 0 Then
　　　　MsgBox "「" & Yougo & "」が取り出されました"
　　Else
　　　　MsgBox "取り出しに失敗しました"
　　End If
　　
End Sub

・ツリー全体表示


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

マナ - 13/5/14(火) 19:52 -


	引用なし

	パスワード

あちこち探しまわったら、こんなのがありました。

Modify embedded Excel workbook in Word document via VBA
ht tp://stackoverflow.com/questions/483813/modify-embedded-excel-workbook-in-word-document-via-vba

＞With Selection.Find
＞　　.ClearFormatting
＞　　.Text = "wiffleball"
＞　　.Execute Forward:=True
＞End With

最後のコメント
＞this problem was driving me crazy
その気持よくわかりました。

あと、こんなのも。

『MS word2003』でグラフを作成するVBAマクロの作成例
ht tp://bloodyrosary.blog8.fc2.com/blog-entry-1351.html

確かにConvertToShapeとかConvertToInlineShapeでうまくいきました。

・ツリー全体表示


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

マナ - 13/5/12(日) 11:34 -


	引用なし

	パスワード

本題とは違いますが。わからないことがります。

>1.Wordで『Excelｼｰﾄの挿入』ﾎﾞﾀﾝでExcelｼｰﾄを挿入後、

この部分もVBAでと、試してみました。こんな感じです。
しかし、★の行でエラーになります。

実行時エラー1004
WorkbookクラスのCloseメソッドが失敗しました

調べてみたら、SendKeysを使っている例がありました。
これで、うまくいくときもあります。
ですが何回か実行すると、エクセル編集画面が開いたままで
ワード編集画面にもどってくれないときがあります。
どうしたらいいのでしょう？

Sub test()
　　Dim myOle As OLEFormat
　　Dim myStr As String

　　Set myOle = ActiveDocument.Shapes.AddOLEObject(ClassType:="Excel.Sheet").OLEFormat
　　
　　With myOle.Object
　　　　　　.Sheets("Sheet1").Range("A1").Value = "test入力"
　　　　　　myStr = .Sheets("Sheet1").Range("A1").Value
'　　　　　　.Close　　　'★ここでエラー
　　　　　　SendKeys "{ESC}", True
　　　　　　.Application.Quit
　　End With
　　
　　MsgBox myStr

End Sub

・ツリー全体表示


	【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

・ツリー全体表示


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

8 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free