1
我正在將SharePoint文檔導出到Excel。一切看起來都很好,直到我運行一個VBA宏將Excel數據移動到PowerPoint文本框中。 (我們無法編寫自定義代碼來繞過Excel中的步驟。)SharePoint 2010將隱藏字符添加到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
終於找到了一個搜索後搜索更多。在字段上做一個Like來檢查小寫字母或數字。如果第一個位置不是我刪除那個角色。我修改了上面的代碼。 – Spiderman