我将SharePoint文档导出到Excel。在运行VBA宏将Excel数据移动到PowerPoint文本框之前，一切看起来都很好。 （我们无法编写自定义代码以在步骤中绕过Excel。）
问题标记位于第一个字符位置，用于那些富文本框的SharePoint字段（在创建文档的InfoPath表单中定义。）
我在Excel中检查了一个问号，但它无法识别它。我相信问号可能是一个符号，而不是一个真正的问号。有没有人碰到这个，如果有的话，你是如何解决它/工作的呢？
我不能简单地切断第一个字符，因为在问号上不会出现问号。
谢谢！
这是宏代码。
Sub valppt()
Dim PPT As PowerPoint.Application
Dim newslide As PowerPoint.SlideRange
Dim slideCtr As Integer
Dim textCtr As Integer
Dim CompRange As Integer
Dim n As Integer
Dim CompRange2 As String
Dim tempString As String
Dim tempString2 As String
Dim hidChar As String
Dim tb As PowerPoint.Shape
Range("AC2:AC10000").Select
Selection.Replace What:="D", Replacement:="2", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="N", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="S", Replacement:="3", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWorkbook.Worksheets("owssvr").ListObjects("Table_owssvr").Sort.SortFields _
.Clear
ActiveWorkbook.Worksheets("owssvr").ListObjects("Table_owssvr").Sort.SortFields _
.Add Key:=Range("Table_owssvr[Status]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("owssvr").ListObjects("Table_owssvr").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AC2:AC10000").Select
Selection.Replace What:="2", Replacement:="D", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="1", Replacement:="N", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="3", Replacement:="S", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.RowHeight = 60
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open ("C:\Documents\RegularMaster.pptm")
Range("F2").Activate
slideCtr = 1
textCtr = 1
Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate
slideCtr = slideCtr + 1
hidChar = "?"
' Do Until ActiveCell.Value = ""
Do Until textCtr = 0
Do Until textCtr > 14
Set tb = newslide.Shapes("TextBox" & textCtr)
'tb.TextFrame.TextRange.Characters.Text = Format(ActiveCell.Value, "m/d/yyyy")
tb.OLEFormat.Object.Value = Format(ActiveCell.Value, "m/d/yyyy")
textCtr = textCtr + 1
ActiveCell.Offset(0, 1).Activate
Loop
textCtr = 15
Do Until textCtr > 21
tempString = ""
tempString2 = Left(ActiveCell.Value, 1)
If ActiveCell.Value <> "" Then
If tempString2 Like "[A-Z,a-z,0-9]" Then
tempString = ActiveCell.Value
Else
tempString = Right(ActiveCell.Value, Len(ActiveCell.Value) - 1)
End If
End If
Set tb = newslide.Shapes("TextBox" & textCtr)
tb.OLEFormat.Object.Value = tempString
textCtr = textCtr + 1
ActiveCell.Offset(0, 1).Activate
tempString2 = ""
Loop
textCtr = 22
Do Until textCtr > 26
Set tb = newslide.Shapes("TextBox" & textCtr)
tb.OLEFormat.Object.Value = ActiveCell.Value
textCtr = textCtr + 1
ActiveCell.Offset(0, 1).Activate
Loop
textCtr = 27
ActiveCell.Offset(0, 3).Activate
Do Until textCtr > 29
tempString = ""
tempString2 = Left(ActiveCell.Value, 1)
If ActiveCell.Value <> "" Then
If tempString2 Like "[A-Z,a-z,0-9]" Then
tempString = ActiveCell.Value
Else
tempString = Right(ActiveCell.Value, Len(ActiveCell.Value) - 1)
End If
End If
Set tb = newslide.Shapes("TextBox" & textCtr)
tb.OLEFormat.Object.Value = tempString
textCtr = textCtr + 1
ActiveCell.Offset(0, 1).Activate
tempString2 = ""
Loop
textCtr = 1
CompRange = Split(ActiveCell.Address, "$")(2)
CompRange2 = "B" & CompRange
Range(CompRange2).Activate
Do Until textCtr > 7
If UCase(ActiveCell.Value) = "TRUE" Then
Set tb = newslide.Shapes("CheckBox" & textCtr)
tb.OLEFormat.Object.Value = UCase(ActiveCell.Value)
End If
textCtr = textCtr + 1
If textCtr < 8 Then
If textCtr = 2 Then
CompRange2 = "AO" & CompRange
ElseIf textCtr = 3 Then
CompRange2 = "AG" & CompRange
ElseIf textCtr = 4 Then
CompRange2 = "AF" & CompRange
ElseIf textCtr = 5 Then
CompRange2 = "AH" & CompRange
ElseIf textCtr = 6 Then
CompRange2 = "AN" & CompRange
Else
CompRange2 = "AP" & CompRange
End If
End If
Range(CompRange2).Activate
Loop
CompRange = Split(ActiveCell.Address, "$")(2)
Application.Goto Range("A" & CompRange), True
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = "" Then
textCtr = 0
Else
Set newslide = PPT.ActivePresentation.Slides(1).Duplicate
textCtr = 1
ActiveCell.Offset(0, 5).Activate
End If
Loop
End Sub
答案 0 :(得分：1)
进行了一些谷歌搜索并找到了答案。喜欢！我检查了该字段是小写还是上限为a-z或0-9。如果不是，我删除第一个字符。这是代码。
Do Until textCtr > 21
tempString = ""
tempString2 = Left(ActiveCell.Value, 1)
If ActiveCell.Value <> "" Then
If tempString2 Like "[A-Z,a-z,0-9]" Then
tempString = ActiveCell.Value
Else
tempString = Right(ActiveCell.Value, Len(ActiveCell.Value) - 1)
End If
End If
Set tb = newslide.Shapes("TextBox" & textCtr)
tb.OLEFormat.Object.Value = tempString
textCtr = textCtr + 1
ActiveCell.Offset(0, 1).Activate
tempString2 = ""
Loop