This function copies cells from an Excel spreadsheet to a PowerPoint
presentation slide. During the copy, it tests to see if the values are
above, between, or below set thresholds. For above, it sets the font format
bold, italic. For below (where the error occurs), it sets the fill color to
a grey.
What's really weird is that this works fine when run from VB6. There must
be something odd about the way .Net interfaces with the PPT OLE object.
Here is the code:
Dim i As Integer
Dim j As Integer
Dim intCellValue As Short
Dim intTableID As Integer
Dim intColStart As Short
Dim intColEnd As Short
Dim intRowStart As Short
Dim intRowEnd As Short
Dim intColor As Integer
Dim lngAnswer As Integer
Dim blnValidCellValue As Boolean
Dim blnAutoReplace As Boolean
intTableID = -1
For i = 1 To pptPresentation.Slides.Item(pintSlide).Shapes.Count
If
pptPresentation.Slides.Item(pintSlide).Shapes.Item(i).HasTable Then
intTableID = i
Exit For
End If
Next i
If intTableID < 0 Then Exit Function
With
pptPresentation.Slides.Item(pintSlide).Shapes.Item(intTableID).Table
intColStart = (Asc(pstrFromCell) - Asc("A"))
intColEnd = ((Asc(pstrToCell) - Asc(pstrFromCell)) + 1)
intRowStart = Int(CDbl(Mid(pstrFromCell, 2)))
intRowEnd = Int(CDbl(Mid(pstrToCell, 2)))
If intColStart + intColEnd > .Columns.Count Then
MsgBox("The range specified to paste cells into the
table has more columns than the PowerPoint table. Please adjust the size of
the PowerPoint table.")
Exit Function
End If
For j = intRowStart To intRowEnd
For i = 2 To
pptPresentation.Slides.Item(pintSlide).Shapes.Item(intTableID).Table.Columns.Count
.Cell(j, i).Shape.TextFrame.TextRange.Font.Bold =
Microsoft.Office.Core.MsoTriState.msoFalse
.Cell(j, i).Shape.TextFrame.TextRange.Font.Underline
= Microsoft.Office.Core.MsoTriState.msoFalse
.Cell(j, i).Shape.Fill.ForeColor.RGB = RGB(255, 255,
255)
'.Cell(j, i).Shape.Fill.Visible =
Microsoft.Office.Core.MsoTriState.msoFalse
.Cell(j, i).Shape.TextFrame.TextRange.Text = ""
Next i
Next j
System.Windows.Forms.Application.DoEvents()
blnAutoReplace = False
For j = intRowStart To intRowEnd
For i = intColStart + 1 To ((Asc(pstrToCell) -
Asc(pstrFromCell)) + 1) + intColStart
blnValidCellValue = True
If
ExcelApp.WorksheetFunction.IsErr(ExcelWorksheet.Cells.Item(j, i)) Then
If blnAutoReplace Then
intCellValue = 0
Else
lngAnswer = MsgBox("The Excel spreadsheet
contains an error result in cell " & Chr(i + Asc("A") - 1) & j & ". Click
Yes to substitute a zero or No to stop processing this slide.",
MsgBoxStyle.YesNo + MsgBoxStyle.DefaultButton2 + MsgBoxStyle.Question)
If lngAnswer = MsgBoxResult.Yes Then
blnAutoReplace = True
intCellValue = 0
Else
Exit Function
End If
End If
Else
If IsNumeric(ExcelWorksheet.Cells.Item(j,
i).Value) And Len(CStr(ExcelWorksheet.Cells.Item(j, i).Value)) <> 0 Then
intCellValue =
System.Math.Round(ExcelWorksheet.Cells.Item(j, i).Value)
Else
blnValidCellValue = False
End If
End If
If blnValidCellValue Then
.Cell(j, i).Shape.TextFrame.TextRange.Text =
Format(intCellValue, "#0")
If pintSampleRow < 0 Or (j - intRowStart + 1 <>
pintSampleRow) Then
If ((intCellValue >= pintMaxVaule) And
(pintMaxVaule >= 0)) Then
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Bold =
Microsoft.Office.Core.MsoTriState.msoTrue
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Underline =
Microsoft.Office.Core.MsoTriState.msoTrue
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Italic =
Microsoft.Office.Core.MsoTriState.msoFalse
'.Cell(j, i).Shape.Fill.Visible() =
Microsoft.Office.Core.MsoTriState.msoFalse
ElseIf ((intCellValue <= pintMinValue) And
(pintMinValue >= 0)) Then
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Italic =
Microsoft.Office.Core.MsoTriState.msoTrue
intColor = RGB(192, 192, 192)
.Cell(j, i).Shape.Fill.ForeColor.RGB =
intColor
.Cell(j, i).Shape.Fill.Visible =
Microsoft.Office.Core.MsoTriState.msoTrue
.Cell(j, i).Shape.Fill.Solid()
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Bold =
Microsoft.Office.Core.MsoTriState.msoFalse
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Underline =
Microsoft.Office.Core.MsoTriState.msoFalse
Else
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Italic =
Microsoft.Office.Core.MsoTriState.msoFalse
'.Cell(j, i).Shape.Fill.Visible =
Microsoft.Office.Core.MsoTriState.msoFalse
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Bold =
Microsoft.Office.Core.MsoTriState.msoFalse
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Underline =
Microsoft.Office.Core.MsoTriState.msoFalse
End If
ElseIf (j - intRowStart + 1 = pintSampleRow) Then
.Cell(j, i).Shape.TextFrame.TextRange.Text =
"[" & ExcelWorksheet.Cells.Item(j, i).Value & "]"
.Cell(j,
i).Shape.TextFrame.TextRange.ParagraphFormat.Alignment =
PowerPoint.PpParagraphAlignment.ppAlignCenter
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Italic =
Microsoft.Office.Core.MsoTriState.msoTrue
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Size = 10
.Cell(j,
i).Shape.TextFrame.TextRange.Font.Name = "Arial"
End If
Else
.Cell(j, i).Shape.TextFrame.TextRange.Text =
ExcelWorksheet.Cells.Item(j, i).Value
End If
Next i
System.Windows.Forms.Application.DoEvents()
Next j
End With
ExcelApp.Quit()
ExcelWorksheet = Nothing
ExcelApp = Nothing
Steve Rindsberg said:
Sorry I didn't answer everything all at once...
I tried defining the variables as longs... This caused an abort. I changed
them back to integer (they originally were defined as short) and still am
getting the error.
Yes, .net has an RGB function. The error almost makes me believe that
there's some kind of problem in the "interop" interface from .Net to the
PowerPoint .Shape.Fill.Forecolor.RGB property.
Unfortunately, I can make this even more obscure. I had forgotten this, but
earlier in the same routine, I have a .cell (j,i).shape.fill.forecolor.rgb =
rgb (255, 255, 255) and it works. All that I want to do is set the
background on specific cells to a light grey. If you have any other
suggestions, I'm open to trying something different.
Weird!
Can you post a bit more code surrounding the bit where the error occurs?
I don't speak .Net but maybe someone else can step in ...
Dan
Steve Rindsberg said:
I have a program I am upgrading from VB6 to VB2005. This function works from
VB6, but generates an exception in VB2005. I am setting a table cell shape
fill forecolor to RBG (200,200,200) [grey]. The code which fails is
basically as follows:
With pptPresentation.Slides.Item(pintSlide).Shapes.Item(intTableID).Table
....
..Cell(j, i).Shape.Fill.ForeColor.RGB = RGB(200, 200, 200)
I have tried every variation I can think of. Any help would be greatly
appreciated.
Do you get some kind of error message?
A couple of ideas:
pintSlide and intTableID -- PPT is looking for Longs in both cases. ISTR that
.Net ints are equivalent to VBA longs, but it's worth checking.
Does .Net have an RGB method?
-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ:
www.pptfaq.com
PPTools:
www.pptools.com
================================================
-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ:
www.pptfaq.com
PPTools:
www.pptools.com
================================================
