Excel-在texboxes中搜索文本

问题描述

在excel中创建文本框时，无法使用搜索/查找文本功能。

Excel不会搜索文本框中包含的文本。

对于像我这样的人来说，这是一个巨大的限制，它在多个工作表中分布了500多个文本框。

我看到很多人在暗示解决方案，这些解决方案绝不等于或取代原始的excel“查找文本”功能。

例如：

https://superuser.com/questions/1367712/find-text-in-the-textbox-in-excel https://excel.tips.net/T011281_Finding_Text_in_Text_Boxes.html

解决方法

我将在这里分享我的解决方法，希望也能帮助其他人。

此vba代码的作用：将所有形状（包括文本框）导出到新的word文档中。

总而言之，搜索功能确实可以在文本框中使用，并且问题已解决。

这是等同于残缺的excel查找文本功能的唯一解决方案。

Sub Export()
' THIS must be enabled in Excel: Developer > Visual basic > Tools > References > Microsoft word 1x Object library
'Known bug: if the worksheet has only 1 textbox it will mess up the copy to word. You can manually fix it by adding another textbox in that worksheet. It can be empty.
'Ctrl+break -> will stop the process
'If Word crashes -> the clipboard size is too large.
'Reduce the sheet size or split it in 2 sheets.
'The clipboard limitation is an excel wide limitation.
    
Dim StartTime As Double
Dim MinutesElapsed As String
StartTime = Timer

MsgBox " Wait for job completed textbox in excel!" & vbCrLf & "Close any other WORD files!"
Dim WordApp As Word.Application
Dim i As Integer
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Application.ScreenUpdating = False
Sheet1.Activate
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
    With WordApp.ActiveDocument.PageSetup
            .PageWidth = InchesToPoints(22)
            .PageHeight = InchesToPoints(22)
    End With

WordApp.ActiveWindow.View.Type = wdWebView

WordApp.Visible = True
WordApp.Application.ScreenUpdating = False
WS_Count = ActiveWorkbook.Worksheets.Count

For i = 1 To WS_Count
    ActiveWorkbook.Sheets(i).Activate
    ActiveWorkbook.Sheets(i).Shapes.SelectAll
    Selection.Copy

PasteChartIntoWord WordApp

If i <> WS_Count Then
    With WordApp.Selection
        .Collapse Direction:=0
        .InsertBreak Type:=7
    End With
End If

Application.CutCopyMode = False

Next i
' Text in textboxes -> apply style: nospacing so that text fits in the textboxes in Word

  Dim objTextBox As Object
  Dim objDoc As Object
  Set objDoc = GetObject(,"Word.Application").ActiveDocument
  For Each objTextBox In objDoc.Shapes
  If objTextBox.TextFrame.HasText Then
  objTextBox.TextFrame.TextRange.ParagraphFormat.LineSpacingRule = 0
  objTextBox.TextFrame.TextRange.ParagraphFormat.SpaceAfter = 0
  End If
  Next objTextBox



Call sourceSheet.Activate
Application.ScreenUpdating = True
WordApp.Application.ScreenUpdating = True


'Determine how many seconds code took to run
  MinutesElapsed = Format((Timer - StartTime) / 86400,"hh:mm:ss")
'Notify user in seconds
  MsgBox "Done! " & MinutesElapsed & " minutes",vbInformation
 End Sub




 Function PasteChartIntoWord(WordApp As Object) As Object

' Remove textbox selection
ActiveCell.Select
  Range("BB100").Select
  ActiveWindow.SmallScroll up:=100
  ActiveWindow.SmallScroll ToLeft:=44

' create a header with sheetname for quick referencing!
WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
WordApp.Selection.Font.Size = 36
WordApp.Selection.Font.Underline = wdUnderlineSingle
WordApp.Selection.Font.ColorIndex = wdRed
WordApp.Selection.TypeText Text:=ActiveSheet.Name

' Paste the textboxes
WordApp.Selection.PasteSpecial DataType:=wdPasteShape

End Function

excel excel find