英文:
How to take variables entered in the userform text box to the array text in the module using VBA in PowerPoint?
问题
我有一个宏来选择幻灯片,其中包含必要的文本,以移动到新的演示文稿中。
我必须从包含500多张幻灯片的演示文稿中提取70-80张幻灯片。但我需要进入VB/模块以更改数组中的关键字/搜索文本。有没有办法将用户窗体中输入的文本移到数组(text)中?
用户窗体用于输入关键字。
我如何将输入的文本与代码中的数组列表关联起来?
Sub selct()
Dim pres1 As PowerPoint.Presentation, pres2 As PowerPoint.Presentation, pp As Object
Set pp = GetObject(, "PowerPoint.Application")
Set pres1 = pp.ActivePresentation
Set pres2 = pp.Presentations.Add
Dim i As Long, n As Long
Dim TargetList
'~~> 用于搜索的术语数组
TargetList = Array("Agenda", "Review", "third", "etc")
'~~> 循环遍历每张幻灯片
For Each sld In pres1.Slides
'~~> 循环遍历每个形状
For Each shp In sld.Shapes
'~~> 检查是否包含文本
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
For i = 0 To UBound(TargetList)
'~~> 查找文本
Set rngFound = txtRng.Find(TargetList(i))
'~~~> 如果找到
Do While Not rngFound Is Nothing
'~~> 设置标记,以便下次查找从这里开始
n = rngFound.Start + 1
'~~> 更改属性
With rngFound.Font
.Bold = msoFalse
sld.Copy
pres2.Slides.Paste
'~~> 查找下一个实例
Set rngFound = txtRng.Find(TargetList(i), n)
End With
Loop
Next
End If
Next
Next
End Sub
英文:
I have a macro to select slides, with required text, to move to a new presentation.
I have to extract 70-80 slides from a 500+ slides presentation. But I need to enter VB/Module to change the keywords/search text in the array. Is there a way I can move the text entered in the userform to the array (text)?
Userform to enter the keywords.
How do I link the text entered with the array list in the code?
Sub selct()
Dim pres1 As PowerPoint.Presentation, pres2 As PowerPoint.Presentation,
pp As Object
Set pp = GetObject(, "PowerPoint.Application")
Set pres1 = pp.ActivePresentation
Set pres2 = pp.Presentations.Add
Dim i As Long, n As Long
Dim TargetList
'~~> Array of terms to search for
TargetList = Array("Agenda", "Review", "third", "etc")
'~~> Loop through each slide
For Each sld In pres1.Slides
'~~> Loop through each shape
For Each shp In sld.Shapes
'~~> Check if it has text
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
For i = 0 To UBound(TargetList)
'~~> Find the text
Set rngFound = txtRng.Find(TargetList(i))
'~~~> If found
Do While Not rngFound Is Nothing
'~~> Set the marker so that the next find starts from here
n = rngFound.Start + 1
'~~> Chnage attributes
With rngFound.Font
.Bold = msoFalse
sld.Copy
pres2.Slides.Paste
'~~> Find Next instance
Set rngFound = txtRng.Find(TargetList(i), n)
End With
Loop
Next
End If
Next
Next
End Sub
答案1
得分: 0
表单对象即使在表单未显示时也是可访问的,就像这样:假设您有一个名为UF1
的表单,其中有一个名为TBforKeyWord
的文本框,然后您可以在UF1.TBforKeyWord
处访问文本框的值,因此您可以
Redim Preserve TargetList(Ubound(TargetList) + 1)
TargetList(Ubound(TargetList)) = UF1.TBforKeyWord
如果允许用户输入多个关键字,那么逻辑是相同的,但是您需要更多工作来分割(和解析)关键字。
编辑
Dim text_array() As String
text_array = Split(SearchBox.Value, " ")
Dim iDimOld As Long
Dim iDimNew As Long
Dim i As Long
iDimOld = Ubound(TargetList)
iDimNew = iDimOld + Ubound(text_array) + 1
Redim Preserve TargetList(iDimNew)
' 遍历数组中的每个关键字
For i = 0 To Ubound(text_array)
TargetList(iDimOld + i + 1) = text_array(i)
Next
英文:
The form objects are accessible even when the form is not shown, like this: Suppose you have a form with name UF1
with a textbox named TBforKeyWord
, then you can access the textbox value at UF1.TBforKeyWord
, so you might
Redim Preserve TargetList(Ubound(TargetList) + 1)
TargetList(Ubound(TargetList) = UF1.TBforKeyWord
The logic is the same if you let the user enter multiple keywords but then you need to work a bit more on splitting (and parsing) the keywords.
EDIT
Dim text_array() As String
text_array = Split(SearchBox.Value, " ")
Dim iDimOld As Long
Dim iDimNew As Long
Dim i As Long
iDimOld = Ubound(TargetList)
iDimNew = iDimOld + Ubound(text_array) + 1
Redim Preserve TargetList(iDimNew)
' Loop through each keyword in array
For i = 0 To Ubound(text_array)
TargetList(iDimOld + i + 1) = text_array(i)
Next
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论