SharePoint 2010将隐藏的字符添加到Excel导出

我正在将SharePoint文档导出到Excel。 一切都很好,直到我运行一个VBAmacros将Excel数据移动到PowerPoint文本框。 (我们没有能力编写自定义代码绕过Excel中的步骤。)

在富文本框的SharePoint字段的第一个字符位置中放置了一个问号(如从创build文档的InfoPath表单中定义的那样)。

我已经在Excel中检查了一个问号,但是它不能识别它。 我相信问号可能是一个象征,而不是一个真正的问号。 有没有人遇到这个,如果是的话,你是如何修复它/工作aorund呢?

我不能简单地切断第一个字符,因为事件中不会出现问号。

谢谢!

这里是macros代码。

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 "[AZ,az,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 "[AZ,az,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 

做了更多的search,并find答案。 喜欢! 我检查,如果该字段是小写字母或az或0-9。 如果没有,我删除第一个字符。 这是代码。

 Do Until textCtr > 21 tempString = "" tempString2 = Left(ActiveCell.Value, 1) If ActiveCell.Value <> "" Then If tempString2 Like "[AZ,az,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