SharePoint 2010 Adds Hidden Characters to Excel Export

Question

I am exporting SharePoint documents to Excel. Everything looks fine until I run a VBA macro to move Excel data into PowerPoint text boxes. (We don't have ability to write custom code to bypass Excel in the step.)

A question mark is being placed in the first character position for those SharePoint fields that were rich text boxes (as defined in the InfoPath forms that the documents are created from.)

I have checked for a question mark in the Excel, but it does not recognize it. I believe the question mark could be a symbol and not a true question mark. Has anyone run into this and if so, how did you fix it/work aorund it?

I can't simply cut off the first character because on occassion the question mark will not appear.

Thanks!

Here is the macro code.

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

SharePoint 2010 Adds Hidden Characters to Excel Export

Answers (1)

Related Questions