L
lance-news
So, I finally am able to retrieve the Maximum value from a Range
in an Embedded Excelsheet. I now have a question regarding Autoshapes.
It is very tedious to find the location in each position for each
autoshape.
Is it possible to specify something like,
add a cirlce that is centered across cells ("B3:C3")
so that I don't have to manually center?
My cells are merged so that B3:C3 are one cell and D3:E3
are one cell ...
Also note that the autoshapes are being inserted on top
of the XL embedded sheet and not directly inside the XL
embedded sheet.
Lance
Sub maxval2()
Dim oXLBook As Excel.Workbook
Dim oXLSheet As Excel.Worksheet
Dim SlideObject As Slide
Dim ShapeObject As Shape
Dim maxval As Variant
For Each SlideObject In Application.ActivePresentation.Slides
For Each ShapeObject In SlideObject.Shapes
If ShapeObject.Type = msoEmbeddedOLEObject Then
If Mid$(ShapeObject.OLEFormat.ProgID, 1, 11) =
"Excel.Sheet" Then
Set oXLBook = ShapeObject.OLEFormat.Object
myRange = oXLBook.Worksheets("Sheet1").Range("B3:O3")
Maxanswer = oXLBook.Application.WorksheetFunction.Max(myRange)
'MsgBox (answer)
myRange1 = oXLBook.Worksheets("Sheet1").Range("B3").Value
myRange2 = oXLBook.Worksheets("Sheet1").Range("D3").Value
myRange3 = oXLBook.Worksheets("Sheet1").Range("F3").Value
myRange4 = oXLBook.Worksheets("Sheet1").Range("H3").Value
myRange5 = oXLBook.Worksheets("Sheet1").Range("J3").Value
myRange6 = oXLBook.Worksheets("Sheet1").Range("L3").Value
myRange7 = oXLBook.Worksheets("Sheet1").Range("N3").Value
If (myRange1 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 225, 180,
36, 36).Select
If (myRange2 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 286, 180,
36, 36).Select
If (myRange3 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 345, 180,
36, 36).Select
If (myRange4 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 405, 180,
36, 36).Select
If (myRange5 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 465, 180,
36, 36).Select
If (myRange6 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 525, 180,
36, 36).Select
If (myRange7 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 585, 180,
36, 36).Select
in an Embedded Excelsheet. I now have a question regarding Autoshapes.
It is very tedious to find the location in each position for each
autoshape.
Is it possible to specify something like,
add a cirlce that is centered across cells ("B3:C3")
so that I don't have to manually center?
My cells are merged so that B3:C3 are one cell and D3:E3
are one cell ...
Also note that the autoshapes are being inserted on top
of the XL embedded sheet and not directly inside the XL
embedded sheet.
Lance
Sub maxval2()
Dim oXLBook As Excel.Workbook
Dim oXLSheet As Excel.Worksheet
Dim SlideObject As Slide
Dim ShapeObject As Shape
Dim maxval As Variant
For Each SlideObject In Application.ActivePresentation.Slides
For Each ShapeObject In SlideObject.Shapes
If ShapeObject.Type = msoEmbeddedOLEObject Then
If Mid$(ShapeObject.OLEFormat.ProgID, 1, 11) =
"Excel.Sheet" Then
Set oXLBook = ShapeObject.OLEFormat.Object
myRange = oXLBook.Worksheets("Sheet1").Range("B3:O3")
Maxanswer = oXLBook.Application.WorksheetFunction.Max(myRange)
'MsgBox (answer)
myRange1 = oXLBook.Worksheets("Sheet1").Range("B3").Value
myRange2 = oXLBook.Worksheets("Sheet1").Range("D3").Value
myRange3 = oXLBook.Worksheets("Sheet1").Range("F3").Value
myRange4 = oXLBook.Worksheets("Sheet1").Range("H3").Value
myRange5 = oXLBook.Worksheets("Sheet1").Range("J3").Value
myRange6 = oXLBook.Worksheets("Sheet1").Range("L3").Value
myRange7 = oXLBook.Worksheets("Sheet1").Range("N3").Value
If (myRange1 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 225, 180,
36, 36).Select
If (myRange2 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 286, 180,
36, 36).Select
If (myRange3 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 345, 180,
36, 36).Select
If (myRange4 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 405, 180,
36, 36).Select
If (myRange5 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 465, 180,
36, 36).Select
If (myRange6 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 525, 180,
36, 36).Select
If (myRange7 = Maxanswer) Then SlideObject.Shapes.AddShape(9, 585, 180,
36, 36).Select