Re: powerpoint automation via vb.net

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

"Steve Rindsberg" wrote:


I'm kinda confused here. You mentioned adding slides out of order before, but I'm not
seeing any code here that adds slides (maybe I'm just missing it though)

In article <7199C6BB-0F6F-4A80-BBFE-2C0D3350E42E@xxxxxxxxxxxxx>, Bikash wrote:
HI!

here is the code. also, if its 30 rows in a row it takes about 10-15min to
render all the ppt as it will be 60 slides. could you also possibly suggest
how could i speed up automation.

------------------------------------------------------
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
Else
ppItem.Visible =
Microsoft.Office.Core.MsoTriState.msoFalse
End If
Catch

End Try
End If
End If
Next
Next

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


ppTarget = Nothing
ppItem = Nothing
ppPres = Nothing
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
----------------------------------------------------

cheers

"Steve Rindsberg" wrote:

In article <864C6E35-829D-4739-8B3D-17DFC182FA5D@xxxxxxxxxxxxx>, Bikash wrote:
Hi!

This really solved my problem but i ran into another issue.

I am sending list of rows from datagrid to powerpoint. each row represents 2
standard slide which is being rendered using a 2slided master slide. now the
problem is the first row becomes the last powerpoint slide and last row
becomes first powerpoint slide. how could i render those rows so that 1 row
becomes 1slide in powerpoint.

Hard to say w/o looking at the code.

But if you insert a list like this:

One
Two
Three

into PPT by inserting a new slide at the same index, say 2, each time you'd get:

Existing slides
One
Existing slides

then

Existing slides
Two
One
Existing slides

then

Existing slides
Three
Two
One
Existing slides

You need to change the index at which you insert the slide to account for the other
slides you've already inserted.






--
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================


.

Loading