[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『462エラーメッセージ リモートサーバーがないか使用できる状態ではありません』（慎之介）
Sub WW_EXCEL()
Dim nm As String, i As Long, n As Variant, c As Long, ip As String
Dim wddoc As Word.Document
Dim wdrg As Word.Range
For Each n In ActiveWorkbook.Names
i = i + 1
nm = nm & i & ":" & n.Name & vbLf
Next n
ip = InputBox("どの様な文章を作成するか番号(1〜)を指定してください。" & vbLf & vbLf & nm)
If ip = "" Then
Exit Sub
End If
Worksheets("入力欄").Activate
Worksheets("入力欄").Range(Split(Split(nm, vbLf)(Val(ip) - 1), ":")(1)).Copy
Set wdrg = ActiveDocument.Paragraphs(10).Range '.Sentences(1).Words(1)
'10行目：wddoc(sample.doc)の1行目を指定
wdrg.Select
wdrg.PasteSpecial , , wdInLine, , wdPasteOLEObject
End Sub
開いたワード文章にエクセルの範囲名の文章を貼付けたいのですがエラーメッセージ出ます。回避方法はないんでしょうか？
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
どこでエラーになるんでしょうか？
Set wdrg = ActiveDocument.Paragraphs(10).Range から wdrg.Select の間に ActiveDocument で捕まえたワードドキュメントが閉じられちゃったりすると wdrg.Select で掲題のエラーになるようです。
その間になんかやってませんか？ （´・ω・`） 2019/12/26(木) 10:53
当方の質問に答えてもらっていないのと私には質問者さんの日本語がよく理解できないのでさようなら 最近は句読点をいれず文も区切らずにだらだら書き続けるのが普通なのかもしませんがわたしもいい年齢なのでついていけません （´・ω・`） 2019/12/26(木) 11:40
Dim wdApp As Word.Application
Dim wddoc As Word.Document
Dim wdRng As Word.Range
Dim Fname As String
Dim sOutput As String
Dim mPath As String
Dim iRowCount As Long
Dim jColCount As Long
Dim sh As Worksheet
Set wdApp = New Word.Application
wdApp.Visible = True
Const dataSheet As String = "data"
Const dataItem As Long = 2 '項目行
Set sh = Worksheets(2)
sh.Select
' ’sOutput = mPath & "\"
mPath = ActiveWorkbook.Path & "\"
Fname = Cells(1, 7).Value
sOutput = mPath & "\"
On Error GoTo ErrHandler
'テンプレート文書
If Dir(Fname) = "" Then
MsgBox "テンプレート文書がありません。", vbExclamation
GoTo ErrHandler
End If
iRowCount = ActiveCell.Row 'dataItem + 1 '先頭data行
With wdApp
Set wddoc = .Documents.Open(Fname)
Set wdRng = wddoc.Content
End With
jColCount = 2
Do
Debug.Print "項目: " & Cells(dataItem, jColCount).Value
Debug.Print "置換: " & Cells(iRowCount, jColCount).Value
With wdRng.Find
.Text = "{" & Cells(dataItem, jColCount).Value & "}"
.Forward = True
If Cells(dataItem, jColCount).Value = "日付" Then
.Replacement.Text = Format(Cells(iRowCount, jColCount).Value, "gggee年mm月dd日")
Else
.Replacement.Text = Cells(iRowCount, jColCount).Value
End If
.MatchCase = False
.MatchWildcards = False
.MatchFuzzy = True
.Execute , , , , , , , , , , wdReplaceAll
End With
jColCount = jColCount + 1
Loop Until sh.Cells(iRowCount, jColCount).Value = ""
sOutput = mPath & Format(Date, "mmdd") & "_" & Cells(iRowCount, 2).Value & ".docm"
Debug.Print "sOutput: " & sOutput
wddoc.SaveAs sOutput '保存word文書名
' wdDoc.Close False
' wdApp.Quit
WW_EXCEL
ErrHandler:
If Err.Number > 0 Then
MsgBox Err.Number & " : " & Err.Description
Else
Beep '正常終了
End If
' Set wdRng = Nothing
'Set wdDoc = Nothing
' Set wdApp = Nothing
' Set sh = Nothing
End Sub
最終のコメント行をどのようにコードを並べるかまったくわかりません自分自身エクセルとワードの連携でデータコピーしたデータをひとつづつ確認して保存出来ればいいと思っておりますがまったくわかりませんお願いします。
（慎之介） 2019/12/26(木) 11:45
(1) Sub WordDocDupulicate() の
Fname = Cells(1, 7).Value
で Cells(1, 7).Value にどんな値が入っているか教えてください
(2) Sub WW_EXCEL() で
Set wdrg = ActiveDocument.Paragraphs(10).Range
で、ActiveDocument を止めてドキュメントを明示する。
[1] Sub WW_EXCEL() プロシジャの宣言部分を 以下に変更
Sub WW_EXCEL(wddoc as Word.Document)
[2] Set wdrg = ActiveDocument.Paragraphs(10).Range を以下に変更
Set wdrg = wddoc.Paragraphs(10).Range
[3] Sub WordDocDupulicate()プロシジャ中 の WW_EXCEL の呼び出し部分を以下に変更
Call WW_EXCEL( wddoc )
(3) Sub WordDocDupulicate 中の On Error GoTo ErrHandler をコメントアウト
以上をした上で、どこでエラーが発生するかおしえてください。
これで曖昧な回答や理解不能な日本語の書き込みがされたらもう知りません。 あ、ちなみにちゃんと回答されても、原因が判明しない場合もあります。 （´・ω・`） 2019/12/26(木) 16:55
あと、どの行でエラーが出るのかもお教えください。
（まっつわん） 2019/12/26(木) 17:09
Sub 整理を試みた()
'Dim wdApp As Word.Application 【Withで対応できるので削除】
'Set wdApp = New Word.Application 【↑により削除】
'Dim sOutput As String 【一旦変数に格納する必要がないので削除】
'Dim mPath As String 【一旦変数に格納する必要がないので削除】
'Dim sh As Worksheet 【Withで対応できるので削除】
Dim wddoc As Word.Document
Dim wdRng As Word.Range
Dim Fname As String
Dim sh As Worksheet
Dim 行 As Long '【「iRowCount」が長ったらしかったので変更】
Dim 列 As Long '【「jColCount」が長ったらしかったので変更】
'Const dataSheet As String = "data" 【使っていないので削除】
Const dataItem As Long = 2 '項目行
With ThisWorkbook
Set sh = .Worksheets(2)
'▼無駄に思えるけどWorksheets(2)の『アクティブセル』の行番号を取得するには必要
sh.Activate
行 = ActiveCell
'▼ワードドキュメントの"ファイル名"を取得
Fname = Dir(.Path & "\" & sh.Range("G7").Value)
'▼ファイルの存在チェック
If Fname = "" Then
MsgBox "テンプレート文書がありません。", vbExclamation
Exit Sub
End If
'▼ワードの操作（ドキュメントを開いてオブジェクト変数にセット）
With New Word.Application
Set wddoc = .Documents.Open(.Path & "\" & Fname)
Set wdRng = wddoc.Content
End With
'▼ワードドキュメントの中を検索？
列 = 2
Do
With wdRng.Find
.Text = "{" & sh.Cells(dataItem, 列).Value & "}"
.Forward = True
If sh.Cells(dataItem, 列).Value = "日付" Then
.Replacement.Text = Format(sh.Cells(行, 列).Value, "gggee年mm月dd日")
Else
.Replacement.Text = sh.Cells(行, 列).Value
End If
.MatchCase = False
.MatchWildcards = False
.MatchFuzzy = True
.Execute , , , , , , , , , , wdReplaceAll
End With
列 = 列 + 1
Loop Until sh.Cells(行, 列).Value = ""
'▼ワードドキュメントを【マクロ付きドキュメント形式】で"前を付けて保存
wddoc.SaveAs2 _
Filename:=mPath & Format(Date, "mmdd") & "_" & Cells(行, 2).Value, _
FileFormat:=wdFormatXMLDocumentMacroEnabled
'-----------------------------------------------------------------------------
'▼WW_EXCELをこちらに移設 ★★たぶん、これが本題★★
Dim 名前の定義 As Object
Dim リスト As String
Dim i As Long
Dim 選択番号 As Long
'Dim wddoc As Word.Document 【使っていないので削除】
Dim wdrg As Word.Range
For i = 1 To .Names.Count
リスト = リスト & i & ":" & .Names(i).Name & vbLf
Next
ラベル:
選択番号 = Application.InputBox(Prompt:="どの様な文章を作成するか番号(1〜" & _
.Names.Count & ")を指定してください。" & vbLf & リスト, Type:=1)
If 選択番号 = False Then End '呼び出し元も含めて全マクロの実行を終了
If 選択番号 < 1 Or 選択番号 > ThisWorkbook.Names.Count Then
MsgBox "1〜" & .Names.Count & "で入力してください。"
GoTo ラベル
End If
.Worksheets("入力欄").Range(.Names(選択番号).Name).Copy
'// ↓【wddocでドキュメントを掴んでいるから"ActiveDocument"じゃなくていいとおもいます。 //
With ActiveDocument.Paragraphs(10).Range
.Select '←必要？
.PasteSpecial , , wdInLine, , wdPasteOLEObject
End With
'-----------------------------------------------------------------------------
End With
End Sub
ワードvbaはサッパリわからないので、根本的に間違ってる部分があるかもしれません。
ちなみに、エラーは出なくなったとのことですが、エラーにならないまでも、使ってない定数・変数を整理したり、無駄に複雑化させているルーチンを考え直した方がいいような気がします。
（要は、ご自身で【ステップ実行】してどこに問題があるのかを探るときに、複雑じゃない方がいいとおもいます。）
（たとえば、ActiveCellに依存してる部分や、名前の定義をコンボボックスから選ばせるとか、、改善の余地がありそうです。）
想像の範囲で申し訳ないですが、エラーが出てたのはExcelを操作する部分じゃなくてWordを操作する部分のほうだったりしませんでしたかね・・・
（もこな２ ） 2019/12/26(木) 18:43
＞WW_EXCEL
じゃ、なんのことかこちらでは想像が付かないので、
ExcelToWord
という名前に勝手に名前を変えてみました。。。
Option Explicit
Sub Main()
ExcelToWord Excel.ThisWorkbook, Word.Application.Documents(1)
End Sub
Private Sub ExcelToWord(ByRef FromWbk As Excel.Workbook, _
ByRef ToDoc As Word.Document)
Dim ix As Variant
Dim s As String
Const cProm As String = "どの様な文章を作成するか番号(1〜)を指定してください。"
s = Get_Names(FromWbk)
ix = Application.InputBox(Prompt:=cProm & vbLf & vbLf & s, Type:=1)
If TypeName(ix) = "Boolean" Then Exit Sub
FromWbk.Names(ix).RefersToRange.Copy
ToDoc.Paragraphs(10).Range.PasteSpecial , , wdInLine, , wdPasteOLEObject
End Sub
Private Function Get_Names(ByRef wb As Excel.Workbook) As String
Dim v() As Variant
Dim i As Long
Dim n As Excel.Name
ReDim v(1 To wb.Names.Count)
For Each n In wb.Names
i = i + 1
v(i) = i & ") " & n.Name
Next
Get_Names = Join(v, vbLf)
End Function
こんなことをやりたいのではないかな？
＞リモートサーバーがないか使用できる状態ではありません
参照しているアプリが分からないという意味じゃないかな？
コードでちゃんと書いてあげないとエクセル君に伝わらないですよ。
（まっつわん） 2019/12/27(金) 10:44
の方がプロシージャy名としてわかりやすいかも？
部下に、
エクセルのブックとワードのドキュメントを渡して、
「これ、転記しておいて。」と頼むと、
部下が、
指定の物を指定の場所に書き込んでくれるイメージで、
プロシージャを作って行ったらいいと思います。
（まっつわん） 2019/12/27(金) 10:50
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.