plotting in excel - ideas welcome

[5pds]

Good evening.

this may seem a strange request.

my problem is that i need to plot containers (that carry cargo) on an area in the spreadsheet that can be removed, named and colour coded. all i have came up with so far is using the drawing tool and physically dragging the conatiner into position. I would like to be in a situation where if i pull a container into the area, the space that it takes up is removed from the areas total foot print.

have any of you guys seen a tool that does a similar thing. I am fairly stumpped here. can conditional format or code be used to deal with this?

help appreciated.

Paul

 

[pbornemeier]

I believe this will do as you asked. This was coded in Excel 2003.
Be sure to update the range in the worksheet that represesnts the area where you are storing containers.
Be sure to update the factor that converts the area of the shape on the screen in pixels squared to the realworld area (meters squared, or whatever).
The shapes you draw to represent containers must be rectangular or square.
If a shape is not completely within the area, it is not counted and the "Area remaining" value shown will not be accurate.

Option Explicit
Sub Main()
    'Shapes completely inside rngArea will subtract their area from the total area
    'If shapes overlap then the total will not be accurate.
    'All shapes are assumed to be square or rectangular
    Dim lX As Long
    Dim rngArea As Range
    Dim lCompletelyInside As Long
    Dim dblScale As Double
    Dim dblAreaSize As Double
    Dim dblAreaRemaining As Double
    Dim lTotalShapes As Long
    Dim lShapesInside As Long
 
    'User Defined Parameters
    'Range on worksheet representing the area used to store containers
    Set rngArea = Range("E4:J42")
    'Factor used to convert the huge number to a realworld value
    dblScale = 1 / 1000
 
    Range("A8:B" & Cells(Rows.Count, 1).End(xlUp).Row).Cells.ClearContents
 
    dblAreaSize = rngArea.Height * rngArea.Width
    lTotalShapes = ActiveSheet.Shapes.Count
 
    dblAreaRemaining = dblAreaSize
    For lX = 1 To lTotalShapes
        If IsCompletelyInside(rngArea, lX) Then
            dblAreaRemaining = dblAreaRemaining - ShapeArea(lX)
            lShapesInside = lShapesInside + 1
            Cells(lShapesInside + 7, 1).Value = ActiveSheet.Shapes(lX).Name
            Cells(lShapesInside + 7, 2).Value = ShapeArea(lX) * dblScale
        End If
    Next
 
    Range("A1").Value = "Total Shapes"
    Range("B1").Value = lTotalShapes
    Range("A2").Value = "Shapes Inside"
    Range("B2").Value = lShapesInside
    Range("A3").Value = "Total Area"
    Range("B3").Value = dblAreaSize * dblScale
    Range("A4").Value = "Area Remaining"
    Range("B4").Value = dblAreaRemaining * dblScale
    Range("A6").Value = "Shapes Inside"
    Range("A7").Value = "Name"
    Range("B7").Value = "Area"
 
End Sub
 
Function ShapeArea(lShapeIndex As Long)
    On Error GoTo Error_Handler
    With ActiveSheet.Shapes(lShapeIndex)
        ShapeArea = .Height * .Width
        Exit Function
    End With
 
Error_Handler:
    ShapeArea = 0
 
End Function
Function IsCompletelyInside(rngRange As Range, lShapeIndex As Long)
    On Error GoTo Error_Handler
    IsCompletelyInside = False
    With ActiveSheet.Shapes(lShapeIndex)
        If .Left >= rngRange.Left And .Top >= rngRange.Top And _
            .Left + .Width <= rngRange.Left + rngRange.Width And _
            .Top + .Height <= rngRange.Top + rngRange.Height Then IsCompletelyInside = True
        Exit Function
    End With
 
Error_Handler:
    IsCompletelyInside = False
 
End Function

 

[5pds]

thanks phil.

any chance you could send me the workbook???

paul@rhynie.net

Regards

 

[pbornemeier]

I cannot send it from my current location. I will send it this evening.