Word VBA質問箱 IV

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

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


1 / 44 ページ 前へ→

【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


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

1)文書を複製して
2)不要なページを削除
3)名前をつけて保存

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


 
・ツリー全体表示

【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でできそうということで、
いただいた関数をヒントに
勉強を進めてみます!

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

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

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

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

質問させていただき、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) 理想的な目標

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

【879】VBAでできること/できないこと
質問  すちぶろん  - 19/6/13(木) 0:38 -

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

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

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


(1) 最低限の目標

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

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

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

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


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

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

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


(3) 理想的な目標

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

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

【878】Re:検索文字の後ろに文字挿入
発言  マナ  - 19/6/11(火) 22:30 -

引用なし
パスワード
   ▼あおぎんこ さん:

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

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ページずつ分割できました。
これでページレイアウトを設定して、1ファイルずつ任意の名前をつけて保存できるように、コードを加えていきたいと思います。

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

ありがとうございました。
・ツリー全体表示

【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
・ツリー全体表示

1 / 44 ページ 前へ→
ページ:  ┃  記事番号:
202910
(SS)C-BOARD v3.8 is Free