Excel

Question

在 excel 中创建文本框时，无法使用 search/find 文本功能。

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

Answer 1

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

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

在 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 - Search text in texboxes

search

vba

textbox

find