Private Sub GeneratePowerpoint(ByVal Titles As DataTable, ByVal pptBtn As
String)
Dim template As String
If pptBtn = "cmdExportPP" Then
template = "OrderForm.ppt"
ElseIf pptBtn = "cmdExportPP1" Then
template = "OrderForm1.ppt"
End If
Dim templateFile As String = PowerPointPath & template
' override the standard ppt file if the user has selected a custom
file
If MyBase.IsCustomReport Then
templateFile = MyBase.CustomReportFile
End If
Dim ppApp As Microsoft.Office.Interop.Powerpoint.Application
Dim ppPres As Microsoft.Office.Interop.Powerpoint.Presentation
Dim ppTarget As Microsoft.Office.Interop.Powerpoint.Slide
Dim ppItem As Microsoft.Office.Interop.PowerPoint.Shape
Dim dr As DataRow
Dim slideCnt As Integer = 0
Dim fieldsRemoved As Boolean = False
Dim currColumn As String
Dim assistantOn As Boolean
Dim qtyIndex As Integer = -1
Dim titleIndex As Integer = -1
Dim shapeIndex As Integer
'Dim oQty As Microsoft.Office.Interop.PowerPoint.Shape
'Dim oTitleID As Microsoft.Office.Interop.PowerPoint.Shape
Dim ppImagePath As String
Dim ppDefaultAgency As String
Dim imageBytes() As Byte
Dim i As Integer
Dim stepBy As Integer
Dim tempFile As String
Dim fileCopied As Boolean
Dim isCorrectFileType As Boolean
Dim dialogResult As dialogResult
Try
dialogResult = MessageBox.Show("Are you sure you want to
generate Powerpoint presentation?", "Generate Powerpoint",
MessageBoxButtons.YesNo, MessageBoxIcon.Question,
MessageBoxDefaultButton.Button2)
If dialogResult = dialogResult.No Then Exit Sub
Cursor = Cursors.WaitCursor
isCorrectFileType =
(Strings.LCase(Strings.Right(Trim(templateFile), 3)) = "ppt")
If (Titles.Rows.Count > 0) And (isCorrectFileType) Then
' create a progress bar as it might take a while
stepBy = CInt(System.Decimal.Floor(100.0 / Titles.Rows.Count))
MyBase.RaiseShowProgress(True, 1, Titles.Rows.Count *
stepBy, stepBy)
'Start Powerpoint and make its window visible but minimized.
ppApp = New Microsoft.Office.Interop.Powerpoint.Application
ppApp.Visible = True
ppApp.WindowState =
Microsoft.Office.Interop.PowerPoint.PpWindowState.ppWindowMinimized
assistantOn = ppApp.Assistant.On
'copy a temp copy of the file
tempFile = System.IO.Path.GetTempPath & template
Try
' clean up the file, change it from read-only then delete
If System.IO.File.Exists(tempFile) Then
System.IO.File.SetAttributes(tempFile,
IO.FileAttributes.Normal)
System.IO.File.Delete(tempFile)
End If
' copy the file, this is so we get a copy of the macros
embedded in the original
System.IO.File.Copy(templateFile, tempFile, True)
System.IO.File.SetAttributes(tempFile,
IO.FileAttributes.Normal)
fileCopied = True
Catch ex As System.IO.IOException
fileCopied = False
MessageBox.Show("The temporary working file used in this
process cannot be created." & vbCrLf & vbCrLf & _
"It is most likely you have a previously
generated presentation open. Close powerpoint and try again" & _
vbCrLf & vbCrLf & ex.Message, "Order
Form", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
If fileCopied Then
ppPres = ppApp.Presentations.Open(tempFile)
' delete the first 'template' slides after it is rendered.
For Each ppTarget In ppPres.Slides
ppTarget.Delete()
Next
' delete the second 'template' slides after it is
rendered.
If ppPres.Slides.Count > 0 Then
ppPres.Slides.Item(1).Delete()
End If
If System.IO.File.Exists(Me.PowerPointPath &
"background.png") Then
ppPres.SlideMaster.Background.Fill.UserPicture(Me.PowerPointPath &
"background.png")
End If
Dim SlideIdx(Titles.Rows.Count) As Integer
For Each dr In Titles.Rows
slideCnt += 1
SlideIdx(slideCnt - 1) = slideCnt
MyBase.RaiseUserMessage("Loading title " &
dr.Item("ISBN"))
MyBase.RaiseSetProgress(slideCnt * stepBy)
Application.DoEvents()
'oSource = ppPres.Slides.(slideCnt,
Microsoft.Office.Interop.PowerPoint.PpSlideLayout.ppLayoutBlank)
'ppPres.Slides.InsertFromFile(templateFile, slideCnt
- 1)
ppPres.Slides.InsertFromFile(templateFile, 0)
ppTarget = ppPres.Slides(slideCnt)
' make sure we grab the background from the
slidemaster
ppTarget.FollowMasterBackground =
Microsoft.Office.Core.MsoTriState.msoTrue
For Each ppTarget In ppPres.Slides
For Each ppItem In ppTarget.Shapes
If ppItem.Type =
Microsoft.Office.Core.MsoShapeType.msoOLEControlObject Then
If ppItem.Name = "txtISBN" Then
ppItem.OLEFormat.Object.Object.Text
= dr.Item("ISBN")
End If
ElseIf (ppItem.Type =
Microsoft.Office.Core.MsoShapeType.msoTextBox) AndAlso _
(Strings.Left(Trim(ppItem.TextFrame.TextRange.Text), 1) = ":") Then
If
UCase(Strings.Left(Trim(ppItem.TextFrame.TextRange.Text), 6)) = ":IMAGE" Then
ppImagePath =
Trim(Strings.Mid(Trim(ppItem.TextFrame.TextRange.Text), 7)) & dr.Item("ISBN")
& Me.ImageExtension
If
CBool(dr.Item("WebImageAvailable")) And (Not
System.IO.File.Exists(ppImagePath)) Then
MyBase.RaiseUserMessage("Getting
web image for " & dr.Item("ISBN"))
Application.DoEvents()
' in this section, pass false to
GetWebImageBytes so that we preserve a copy rather than downloading every time
' see if the UK hi-res image is
available
TitleDetail.GetWebFile(dr.Item("LargeImageURL"), ppImagePath)
If Not
System.IO.File.Exists(ppImagePath) Then
' see if the UK lo-res image
is available
TitleDetail.GetWebFile(dr.Item("SmallImageURL"), ppImagePath)
End If
End If
' as the last resort use the local
low res image
If Not
System.IO.File.Exists(ppImagePath) Then
ppImagePath = Me.ImagePath &
dr.Item("ISBN").ToString & ImageExtension
End If
If
System.IO.File.Exists(ppImagePath) Then
ppTarget.Shapes.AddPicture(ppImagePath, False, True, ppItem.Left, ppItem.Top,
ppItem.Width, ppItem.Height)
End If
ppItem.TextFrame.TextRange.Text = ""
ElseIf
UCase(Strings.Left(Trim(ppItem.TextFrame.TextRange.Text), 11)) =
":AGENCYLOGO" Then
' agencylogo
ppImagePath = PowerPointPath &
dr.Item("ImprintCode") & ".gif"
ppDefaultAgency = PowerPointPath &
"defaultagency.gif"
If
System.IO.File.Exists(ppImagePath) Then
ppTarget.Shapes.AddPicture(ppImagePath, False, True, ppItem.Left, ppItem.Top,
ppItem.Width, ppItem.Height)
ElseIf
System.IO.File.Exists(ppDefaultAgency) Then
ppTarget.Shapes.AddPicture(ppDefaultAgency, False, True, ppItem.Left,
ppItem.Top, ppItem.Width, ppItem.Height)
End If
ppItem.TextFrame.TextRange.Text = ""
Else
' wrap in try catch, in case the
column requested doesn't exist don't raise an error
Try
If
Len(Trim(dr.Item(Strings.Right(Trim(ppItem.TextFrame.TextRange.Text),
Len(Trim(ppItem.TextFrame.TextRange.Text)) - 1)))) > 0 Then
Dim s As String =
dr.Item(Strings.Right(Trim(ppItem.TextFrame.TextRange.Text),
Len(Trim(ppItem.TextFrame.TextRange.Text)) - 1))
s = s.Trim
Dim newStr As String
newStr = Replace(s,
Chr(224), " ")
ppItem.TextFrame.TextRange.Text = Replace(newStr, Chr(10), "")
Dim a, b, looplen As Integer
Dim starts, ends, length As
Integer
looplen = s.Length
Dim hashWords As String()
Dim strWord As String
For a = 0 To looplen - 1
If s.Substring(a, 1) =
Chr(224) Then
starts = a
a += 1
For b = 1 To looplen
- 1
If
s.Substring(a, 1) = Chr(224) Then
ends = a
length =
ends - starts + 1
ppItem.TextFrame.TextRange.Characters(starts, length).Font.Bold = True
strWord = ""
Exit For
End If
strWord +=
s.Substring(a, 1)
a += 1
Next
End If
Next
'========================
'If Strings.Left(s, 6) =
"{\rtf1" Then
' Try
' ' copy to clipboard
and paste special if rtf data
' ' Dim data As New
DataObject
'
'data.SetData(DataFormats.Rtf, True, s)
' '
data.SetData(DataFormats.Text, "test")
'
'Clipboard.SetDataObject(data, True)
' 'data = Nothing
' Dim x As New
RichTextBox
' x.Rtf = s
' x.SelectAll()
' x.Copy()
' '
ppItem.TextFrame.TextRange.PasteSpecial(Microsoft.Office.Interop.PowerPoint.PpPasteDataType.ppPasteText)
' If
Clipboard.GetDataObject().GetDataPresent(DataFormats.Rtf) = True Then
'
ppItem.TextFrame.TextRange.PasteSpecial(Microsoft.Office.Interop.PowerPoint.PpPasteDataType.ppPasteRTF)
' End If
' Catch ex As Exception
'
MessageBox.Show(ex.ToString)
' End Try
'Else
'
ppItem.TextFrame.TextRange.Text = s
'End If
Else
ppItem.Visible =
Microsoft.Office.Core.MsoTriState.msoFalse
End If
Catch
End Try
End If
End If
Next
Next
' This code relates to the capturing of quantities
for an order, see code below that loops thru
' commented out until this functionality is requested
'If qtyIndex < 0 Then
' For shapeIndex = 1 To ppTarget.Shapes.Count
' ppItem = ppTarget.Shapes(shapeIndex)
' If ppItem.Type =
Microsoft.Office.Core.MsoShapeType.msoOLEControlObject Then
' If ppItem.Name = "txtQty" Then
' qtyIndex = shapeIndex
' ElseIf ppItem.Name = "txtTitleID" Then
' titleIndex = shapeIndex
' End If
' End If
' Next
'End If
ppTarget = Nothing
Next
ppApp.WindowState =
Microsoft.Office.Interop.PowerPoint.PpWindowState.ppWindowMaximized
'Modify the slide show transition settings for all 3
slides in
'the presentation.
With ppPres.Slides.Range(SlideIdx).SlideShowTransition
.AdvanceOnTime = False
' .AdvanceTime = 3
.EntryEffect =
Microsoft.Office.Interop.PowerPoint.PpEntryEffect.ppEffectBoxOut
End With
'Prevent Office Assistant from displaying alert messages.
ppApp.Assistant.On = False
End If
ElseIf (Not isCorrectFileType) Then
MessageBox.Show("The selected Powerpoint template is not
valid. It must have a 'ppt' file extension.", "Order Form", _
MessageBoxButtons.OK, MessageBoxIcon.Warning)
Else
MessageBox.Show("There are no titles with which to generate
the presentation", "Order Form", MessageBoxButtons.OK, MessageBoxIcon.Warning)
End If
Catch
Throw
Finally
'Reenable Office Assisant, if it was on.
If assistantOn Then
ppApp.Assistant.On = True
ppApp.Assistant.Visible = False
End If
'Close the presentation without saving changes and quit
PowerPoint.
' ppPres.Saved = True
' ppPres.Close()
ppTarget = Nothing
ppItem = Nothing
ppPres = Nothing
' ppApp.Quit()
ppApp = Nothing
' This is important because we want the GC to clean up our
memory from unmanaged code (eg COM interop to powerpoint)
GC.Collect()
MyBase.RaiseShowProgress(False, 1, 100, 1)
MyBase.RaiseUserMessage("")
Cursor = Cursors.Default
End Try
End Sub
