目前我正在使用Rough.docx ，在其中选择一些文本并在名为Ticker Graveyard.Docx （已打开）的另一个文件中查找选定的文本。 一切顺利，但有一个转折点。 我需要通过使用Windows().Activate “Ticker Graveyard.Docx”来默默地完成所有工作Windows().Activate 。
Sub Ticker_Finder_Updated_2() Dim SD As String Dim NAME As String Dim TICKER As String SD = Trim(selection.Text) Windows("Ticker Graveyard").Activate ''''''''''''' selection.Find.ClearFormatting With selection.Find .Text = SD .Forward = True .Wrap = wdFindContinue .MatchWildcards = False .MatchWholeWord = True End With selection.Find.Execute If selection.Find.Found Then If selection.Font.Bold = True Then selection.MoveRight Unit:=wdCell TICKER = selection.Text selection.MoveLeft Unit:=wdCell NAME = selection.Text Else selection.MoveLeft Unit:=wdCell NAME = selection.Text selection.MoveRight Unit:=wdCell TICKER = selection.Text End If selection.HomeKey Unit:=wdStory Windows("Rough").Activate With selection .Font.Size = 9 .TypeText (TICKER) .Delete Unit:=wdCharacter, COUNT:=1 .HomeKey Unit:=wdLine .MoveUp Unit:=wdLine, COUNT:=1 .Font.Size = 9 .TypeText (NAME) .HomeKey Unit:=wdLine .Font.Size = 9 .Font.Bold = True .TypeText Text:="{END}{COMPANY NEWS}" .MoveUp Unit:=wdParagraph, COUNT:=1, Extend:=wdExtend End With Else Windows("Rough").Activate selection.MoveRight Unit:=wdCharacter, COUNT:=1 End If End Sub可以在不创建任何WordObject情况下完成吗？ 善意帮助。 任何其他方法这样做将不胜感激。
Ticker Graveyard ：在表格中有'公司名称'和'Tickers'，这样当我在我的Rough文件中只有公司名称时，我可以看到它的代码。
Currently I am working on Rough.docx where I select some text and find the selected text in a another file having named Ticker Graveyard.Docx (already opened). Everything works smoothly but there is a twist. I need to do all finding work silently without activating the "Ticker Graveyard.Docx" by using Windows().Activate.
Sub Ticker_Finder_Updated_2() Dim SD As String Dim NAME As String Dim TICKER As String SD = Trim(selection.Text) Windows("Ticker Graveyard").Activate ''''''''''''' selection.Find.ClearFormatting With selection.Find .Text = SD .Forward = True .Wrap = wdFindContinue .MatchWildcards = False .MatchWholeWord = True End With selection.Find.Execute If selection.Find.Found Then If selection.Font.Bold = True Then selection.MoveRight Unit:=wdCell TICKER = selection.Text selection.MoveLeft Unit:=wdCell NAME = selection.Text Else selection.MoveLeft Unit:=wdCell NAME = selection.Text selection.MoveRight Unit:=wdCell TICKER = selection.Text End If selection.HomeKey Unit:=wdStory Windows("Rough").Activate With selection .Font.Size = 9 .TypeText (TICKER) .Delete Unit:=wdCharacter, COUNT:=1 .HomeKey Unit:=wdLine .MoveUp Unit:=wdLine, COUNT:=1 .Font.Size = 9 .TypeText (NAME) .HomeKey Unit:=wdLine .Font.Size = 9 .Font.Bold = True .TypeText Text:="{END}{COMPANY NEWS}" .MoveUp Unit:=wdParagraph, COUNT:=1, Extend:=wdExtend End With Else Windows("Rough").Activate selection.MoveRight Unit:=wdCharacter, COUNT:=1 End If End SubCan it be done without creating any WordObject? kindly help. any-other method of doing this will b appreciated.
Ticker Graveyard: has 'Company Names' and their 'Tickers' in a Table so that when ever I had only name of Company in my Rough file I can catch its ticker.
最满意答案
如果没有Window.Activate您可以轻松完成此Window.Activate但要使用这种代码（“interop”），您需要一个Word.Document对象。 如果您要操作第二个文档的WordOpenXML，则可以在关闭的文件上执行该操作。 但是，Word-VBA没有内置工具来处理Office Open XML压缩包。 这是可能的，但这个讨论超出了StackOverflow Q＆A。
由于您在word-vba标签中发布了这些内容，因此我会告诉您如何“无声地”处理第二个文件 - 而不激活第二个文档正在运行的窗口。
为了使用Range范围在表格单元格之间移动，您可以使用也可识别Unit:=wdCell的MoveStart和MoveEnd方法。 既然你只想在Range中找到信息，我在If添加了一个检查。
假设粗体只能在一列中，不需要移动两个方向。 你得到第一个信息，他们移动到邻接的单元格获得第二个位。
当查询单元格的Range.Text您将随同文本一起拾取单元格的内部结构。 将Chr（13）和Chr（7）附加到字符串。 有很多方法可以解决这个问题 - 我已经将其中的一个放在了一个修饰字符并返回字符串的小函数中。
Sub Ticker_Finder_Updated_2() Dim SD As String Dim NAME As String Dim TICKER As String SD = Trim(selection.Text) 'Actions in document currently not active Dim doc as Word.Document Dim rng as Word.Range Set doc = Application.Windows("Ticker Graveyard").Document Set rng = doc.Content rng.Find.ClearFormatting With rng.Find .Text = SD .Forward = True .Wrap = wdFindContinue .MatchWildcards = False .MatchWholeWord = True End With rng.Find.Execute If rng.Find.found And rng.Information(wdWithInTable) Then If rng.Font.Bold = True Then NAME = TrimCellText(rng.Cells(1).Range) rng.MoveStart wdCell, 1 TICKER = TrimCellText(rng.Cells(1).Range) Else TICKER = TrimCellText(rng.Cells(1).Range) rng.MoveStart Unit:=wdCell, Count:=-1 NAME = TrimCellText(rng.Cells(1).Range) End If 'Actions in currently active document - would also be better with 'a Range specific to this document With selection .Font.Size = 9 .TypeText (TICKER) .Delete Unit:=wdCharacter, COUNT:=1 .HomeKey Unit:=wdLine .MoveUp Unit:=wdLine, COUNT:=1 .Font.Size = 9 .TypeText (NAME) .HomeKey Unit:=wdLine .Font.Size = 9 .Font.Bold = True .TypeText Text:="{END}{COMPANY NEWS}" .MoveUp Unit:=wdParagraph, COUNT:=1, Extend:=wdExtend End With selection.MoveRight Unit:=wdCharacter, COUNT:=1 End If End Sub Function TrimCellText(r As word.Range) As String Dim sLastChar As String Dim sCellText As String sCellText = r.Text sLastChar = Right(sCellText, 1) Do While sLastChar = Chr(7) Or sLastChar = Chr(13) sCellText = Left(sCellText, Len(sCellText) - 1) sLastChar = Right(sCellText, 1) Loop TrimCellText = sCellText End FunctionYou can do it easily without Window.Activate but to use this kind of code ("interop") you do need a Word.Document object. If you were to manipulate the WordOpenXML of the second document, you could perform that on the closed file. Word-VBA, however, has no built-in tools for working with Office Open XML zip packages. It is possible, but that discussion exceeds a StackOverflow Q&A.
Since you post this in the word-vba tag I'll show you how you can work with the second file "silently" - without activating the Window in which the second document is running.
In order to move between table cells using a Range, you can work with the MoveStart and MoveEnd methods that also recognize Unit:=wdCell. Since you only want to pick up information if the Range is in a table, I added a check for that to the If.
Assuming Bold can be in only the one column, it's not necessary to move two directions. You get the first bit of information, them move to the adjaceent cell to get the second bit.
When querying a cell's Range.Text you're going to pick up the cell's internal structures along with the text. That appends Chr(13) & Chr(7) to the string. There are various ways to get around that - I've put one of these in a little function that trims the characters and returns the string.
Sub Ticker_Finder_Updated_2() Dim SD As String Dim NAME As String Dim TICKER As String SD = Trim(selection.Text) 'Actions in document currently not active Dim doc as Word.Document Dim rng as Word.Range Set doc = Application.Windows("Ticker Graveyard").Document Set rng = doc.Content rng.Find.ClearFormatting With rng.Find .Text = SD .Forward = True .Wrap = wdFindContinue .MatchWildcards = False .MatchWholeWord = True End With rng.Find.Execute If rng.Find.found And rng.Information(wdWithInTable) Then If rng.Font.Bold = True Then NAME = TrimCellText(rng.Cells(1).Range) rng.MoveStart wdCell, 1 TICKER = TrimCellText(rng.Cells(1).Range) Else TICKER = TrimCellText(rng.Cells(1).Range) rng.MoveStart Unit:=wdCell, Count:=-1 NAME = TrimCellText(rng.Cells(1).Range) End If 'Actions in currently active document - would also be better with 'a Range specific to this document With selection .Font.Size = 9 .TypeText (TICKER) .Delete Unit:=wdCharacter, COUNT:=1 .HomeKey Unit:=wdLine .MoveUp Unit:=wdLine, COUNT:=1 .Font.Size = 9 .TypeText (NAME) .HomeKey Unit:=wdLine .Font.Size = 9 .Font.Bold = True .TypeText Text:="{END}{COMPANY NEWS}" .MoveUp Unit:=wdParagraph, COUNT:=1, Extend:=wdExtend End With selection.MoveRight Unit:=wdCharacter, COUNT:=1 End If End Sub Function TrimCellText(r As word.Range) As String Dim sLastChar As String Dim sCellText As String sCellText = r.Text sLastChar = Right(sCellText, 1) Do While sLastChar = Chr(7) Or sLastChar = Chr(13) sCellText = Left(sCellText, Len(sCellText) - 1) sLastChar = Right(sCellText, 1) Loop TrimCellText = sCellText End Function更多推荐
发布评论