Magnification Lens - Background?

Hi guys,

I'm kinda stuck on thisone. I've been coding a magnifier glass macro, which works quite okay for the moment. Only thing, I cannot figure out how to do, is to set the background to non-transparent within the lens, that I use for magnification.

Here's the code I've come up with so far:

Public Sub lupeNeu()
  Dim s1 As shape, s2 As shape, s3 As Effect, s4 As ShapeRange, s5 As shape
  Dim l1 As Layer
  Dim Shift As Long
  Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
  
  '***** New Layer
  If Not LayerExists("Lupen") Then ActivePage.CreateLayer ("Lupen")
  
  Set l1 = ActivePage.Layers("Lupen")
  
  '***** no more used
  'Set s1 = ActivePage.Layers("Abbildung").FindShape(, cdrBitmapShape)
  
  '***** Define glass size and origin
  ActiveDocument.GetUserArea x1, y1, x2, y2, Shift, 100, False, cdrCursorSmallcrosshair
  
  '**** Store the origin
  xSafe = x1
  ySafe = y1
  
  '***** Create magnified lens
  Set s2 = ActiveLayer.CreateEllipse2(x1, y1, calcDist(x1, y1, x2, y2))
  Set s3 = s2.CreateLens(cdrLensMagnify, 3)
  s3.Lens.Freeze
  
  '***** Define the drag-out location
  ActiveDocument.GetUserArea x1, y1, x2, y2, Shift, 100, False, cdrCursorSmallcrosshair
  
  '***** Move the lens out there
  Set s4 = s3.Lens.Shapes.All
  s4.Move x2 - xSafe, y2 - ySafe
  
  '***** Create a callout-style-line
  Set s5 = l1.CreateLineSegment(xSafe, ySafe, x2, y2)
  s5.OrderToBack

End Sub

So far, everything I came up with ended in errors. Any help would be appreciated.

EDIT:

Sorry for the inconvenience guys. Here's the missing two custom functions missing:

Public Function LayerExists(ByVal strLayerName As String) As Boolean
     ' This function will return true if the layer name passed exists
    Dim objLayer As Layer
    On Error Resume Next
    Set objLayer = ActivePage.Layers(strLayerName)
    LayerExists = Not objLayer Is Nothing
End Function

Public Function calcDist(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double
  Dim returner As Double
  returner = Math.Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
  calcDist = returner
End Function