2017-05-02 8 views
-1

テキスト文書のプレースホルダをExcelセルの文字列に置き換えようとしています。文字列が長すぎてExcelからWord文書にデータをコピーしています

文字列が255文字未満の場合は問題ありませんが、文字列が大きい場合は問題ありません。

コード:

Sub Sheet003ADes() 
    'Sheet 3A- Multi-Family Housing ----------------------------- 

    With Selection.Find 
     .ClearFormatting 
     .Text = "[[3A DESCRIPTION]]" 
     .Replacement.ClearFormatting 
     .Replacement.Text = Worksheets("3A- Multi-Family Housing").Range("A4").Value 'Insert 3A Activity Description 
     .Execute Replace:=wdReplaceAll, Forward:=True, _ 
     Wrap:=wdFindContinue 
    End With 


End Sub 
+0

@Bugs VBAが長い文字列を切り捨てる場合があります。 –

+0

このコードにはあなたが表示していないものがありますか?そのままでは、Excelでは実行されず、最初の行With With Selection.Find(引数の数が間違っています)で失敗します。 –

+0

このコードを正しく実行するように調整しても、実行時エラー5854が発生するはずです。http://imgur.com/RzExsXK実際のエラーをマスクするか無視するには、「On Error Resume Next」や他の愚かさを使用していますか? –

答えて

1

グレッグ・マクシー(WordのVBA MVP)には便利かもしれないいくつかのヒントがあります。

http://gregmaxey.com/word_tip_pages/find_replace_long_string.html

は、あなたがOn Error Resume Nextでこれを無視しなければなりません(この行を取り除くと、あなたは以下のようなエラーが表示されます)ので、Replacement.Textに255文字の制限があります。

enter image description here

彼の提案限り、あなただけ(例えば、.Copy範囲または選択する)、しかしからWord文書の間、またはWord文書内のものをやっていると正常に動作クリップボードを活用することですExcelのような他のアプリケーションでは、おそらく、彼が概説したトリックを使用する前に、テキストをクリップボードに入れるために仲介者としてMsForms.DataObjectを使用する必要があると思います。

のような何か:クリップボードを使用して

Const wdReplaceAll As Long = 2 
Const wdFindContinue As Long = 1 
Dim longString As String 
Dim wd As Object, doc As Object, sel As Object 
Dim dataObj As New DataObject '## Requires reference to MSForms 
'## Alternatively: 
' Dim dataObj as Object 
' Set dataObj = CreateObject("MSForms.DataObject") 

Set wd = GetObject(, "Word.Application") 
Set doc = wd.ActiveDocument 

longString = Worksheets("3A- Multi-Family Housing").Range("A4").value 

dataObj.SetText longString 
dataObj.PutInClipboard 

Set sel = doc.Range 
sel.Select 

With doc.Range.Find 
    .ClearFormatting 
    .Text = "[[3A Description]]" 
    .Replacement.ClearFormatting 
    .Replacement.Text = "^c" 
    .Execute Replace:=wdReplaceAll, Forward:=True, _ 
     Wrap:=wdFindContinue 
End With 
+0

さて、私はそれを試してみます。 –

+0

MSフォーム参照を追加する必要がありましたが、ここでは動作するバージョンがあります。 –

+0

乾杯、 'DataObject'が' MsForms'のメンバであることを忘れてしまったので、それを示す答えを改訂します。 –

0

おかげでトリックをしました。

現在の作業バージョンです。

Sub InputContractData() 
' 
' You must pick Microsoft Excel Object Library from Tools>References 
' in the Visual Basic editor to execute Excel commands. 

' InputContractData Macro 
' 
' 

'Define Excel and Workbook Information 
Dim objExcelApp As Excel.Application 
Dim objCDCDataWorkbook As Workbook 
Dim CDCDataFile 
Dim CDCDataFilePath 
Dim CDCDataFileName 

'Define Word and Document Information 
Dim objWordApp As Word.Application 
Dim objWordDoc As Word.Document 

'Open Excel Program 
Set objExcelApp = New Excel.Application 

Set objWordApp = Word.Application 
Set objWordDoc = objWordApp.ActiveDocument 
objExcelApp.Visible = True 
objWordApp.Visible = True 
CDCDataFile = objExcelApp.GetOpenFilename("Excel Files (*.xlsx), *xlsx") 
Set objCDCDataWorkbook = objExcelApp.Workbooks.Open(CDCDataFile) 
CDCDataFilePath = Left(CDCDataFile, InStrRev(CDCDataFile, "\")) 

CDCDataFileName = Dir(CDCDataFile) 

Call Sheet001 
Call Sheet002 
Call Sheet003ADes 
Call Sheet003AFunding 
Call Sheet003ATasks 
Call Sheet003Accomplishments 
Call Sheet010 
Call Sheet010A 
Call Sheet010E 
Call Sheet010F 
Call Sheet010G 
Call Sheet010D 
Call Sheet010C 
Call SheetLowModCT 

'Save Document in same folder as CDC Workbook 
    objWordDoc.SaveAs CDCDataFilePath & "\DraftContract.docx" 

' Close the new Word document. 
    objWordApp.ActiveDocument.Close 
' Close the Word application. 
    objWordApp.Quit 

End Sub 

Sub Sheet003ADes() 
'Sheet 3A- Multi-Family Housing ----------------------------- 
' Long String requires copying to clipboard and pasting in text 
' Add MS Forms Reference 

Dim longString As String 
Dim sel As Object 
Dim obj3ADes As New DataObject 

longString = Worksheets("3A- Multi-Family Housing").Range("A4").Value 'Copy 3A Activity Description 

obj3ADes.SetText longString 
obj3ADes.PutInClipboard 

With Selection.Find 
    .ClearFormatting 
    .Text = "[[3A DESCRIPTION]]" 
    .Replacement.ClearFormatting 
    .Replacement.Text = "^c" 'Paste 3A Activity Description 
    .Execute Replace:=wdReplaceAll, Forward:=True, _ 
     Wrap:=wdFindContinue 
End With 

End Sub 
関連する問題