Excel/Code

Advertisement


Question
QUESTION: Tom, I appreciate the previous help you've been with my project.  I've run across another snag that I can't seem to find a simple solution to.

Part of the application produces an input box where the user will input a cell location, i.e. "a1".  This information will be saved as the coordinate location in Sheet2 "f2" for an associated image that is pasted at that location, so that other macros can move it around the screen through the use of movement buttons.  What I need is for Sheet 2 "f3:f7" to automatically determine the other cells that are being covered by the image so that another image can't be placed on top of the existing one.  

So far I have:

Option Compare Text

Sub ImageLocation()
Dim S1, S2 as Worksheet
Dim Col as String
Dim RRow as Long
Set S1 = Sheets("sheet1")
set S2 = Sheets("sheet2")
If S2.Range("f2") like "a*" then
    Col = "b"
ElseIf S2.Range("f2") like "a*"then
    Col = "c"
End If
If S2.Range("f2") like "*1" then
    RRow = 2
ElseIf S2.Range("f2") like "*2" then
    RRow = 3
End If
S2.range("f3") = Col & RRow
End Sub

Given that some of the photos will occupy up to 6 cells and that the orientation can possibly change, using this code I'd essentially have to develop this code with a very large if statement for each possible size and orientation of image. That would be a rather large pain, though not impossible.  I'm looking for a more elegant solution that would automatically read the letters (could possibly be "aa" as well) to determine the column so I could make the appropriate modifications to then input the correct location reference in the following cell.

Any and all help is much appreciated.

ANSWER: Charles,

Not really following.  But you can get the topleftcell and bottomright cell from the picture.

So I show how you can loop through all pictures on the sheet and see what area they cover.


Dim pic as Picture
Dim tl as Range, br as Range
Dim rangecovered as Range
for each pic in Activesheet.pictures
 set tl = pic.TopleftCell
 set br = pic.BottomRightCell
 set rangecovered = Range(tl,br)
 msgbox rangecovered.Address
Next

you can use this to check if the space if available.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Tom, Thanks, I'm having a related issue.  I've successfully turned this into a sub to check location against all other appropriate pictures I need to.  I've been trying to turn it into a function so that I can call it from multiple subs to check against those images.  I'm thinking it needs to be Boolean but am unsure how to define the parameters or call it from the other sub.  

I want the parameter to simply be the name of the image we want to check against the rest of the pictures. So I was thinking

Function CheckLocation(Image as Picture) as Boolean

This seemed to work, but when I tried to call it from the other sub with

If CheckLocation = False then goto invalid

I got a Expected Array error.

From what I understand I need to Dim CheckLocation as Boolean in the sub I want to run it in, but to no avail.  Here is the code for the CheckLocation Sub

Sub CheckLocation()
On Error GoTo ec
Dim Game As Worksheet
Dim TL, BR, RCell, CCell As Range
Dim Pic As Picture
Dim Col As Long
Dim ACol, BCol, TLC, BRC, TLC2, BRC2 As String
Set Game = Sheets("Game")
Set Image = Game.Shapes(Game.Range("a13"))
If Image.Name Like "*Token*" Then
   Set TL = Image.TopLeftCell
   Set BR = Image.BottomRightCell
   Col = TL.Column
   If Col < 27 Then
       ACol = Chr(64 + Col)
   ElseIf Col > 26 Then
       ACol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
   End If
   Col = BR.Column
   If Col < 27 Then
       BCol = Chr(64 + Col)
   ElseIf Col > 26 Then
       BCol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
   End If
   TLC = ACol & TL.Row
   BRC = BCol & BR.Row
   For Each Pic In Game.Pictures
       If Pic.Name Like "*Token*" Then
         If Pic.Name <> Image.Name Then
         Set TL = Pic.TopLeftCell
         Set BR = Pic.TopLeftCell
         Col = TL.Column
         If Col < 27 Then
         ACol = Chr(64 + Col)
         ElseIf Col > 26 Then
         ACol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
         End If
         Col = BR.Column
         If Col < 27 Then
         BCol = Chr(64 + Col)
         ElseIf Col > 26 Then
         BCol = Chr(Int((Col / 26) + 64)) & Chr(((Col) Mod 26) + 64)
         End If
         TLC2 = ACol & TL.Row
         BRC2 = BCol & TL.Row
         For Each RCell In Game.Range(TLC & ":" & BRC)
         For Each CCell In Game.Range(TLC2 & ":" & BRC2)
         If RCell.Address = CCell.Address Then GoTo Invalid
         Next CCell
         Next RCell
         End If
       End If
   Next Pic
End If
Exit Sub
Invalid:
MsgBox "A figure already occupies that space, please try again."
Exit Sub
ec:
MsgBox Err.Description
End Sub

As always, any and all help is appreciated.

Charles

Answer
Charles,

Dim TL, BR, RCell, CCell As Range

dimensions

TL as Variant
BR as Variant
RCell as Variant
CCell as Range

If you wanted them to all be Ranges then

Dim TL as Range, BR as Range, RCell as Range, CCell as Range

however, I would use Intersect to see if ranges overlapped

Sub CheckLocation()
On Error GoTo ec
Dim Game As Worksheet
Dim TL As Range, BR As Range
Dim PicRange As Range, ImageRange As Range
Dim Pic As Picture
Dim Image As Shape
Set Game = Sheets("Game")
Set Image = Game.Shapes(Game.Range("a13"))
If Image.Name Like "*Token*" Then
   Set TL = Image.TopLeftCell
   Set BR = Image.BottomRightCell
   Set ImageRange = Game.Range(TL, BR)
   For Each Pic In Game.Pictures
       If Pic.Name Like "*Token*" Then
         If Pic.Name <> Image.Name Then
         Set PicRange = Game.Range(Pic.TopLeftCell, Pic.BottomRightCell)
         If Not Intersect(PicRange, ImageRange) Is Nothing Then GoTo Invalid
         End If
       End If
   Next Pic
End If
Exit Sub
Invalid:
MsgBox "A figure already occupies that space, please try again."
Exit Sub
ec:
MsgBox Err.Description
End Sub


If you want to checklocation to be a function that you call as you show in your description then:

' this is your routine from above renamed and modified to call the CheckLocation Function
' Note that CheckLocation is treated like a build in function.  It needs no declaration
' or dimensioning in the calling routine.

Sub NewCheckLocation()
'On Error GoTo ec
Dim Game As Worksheet
Dim TL As Range, BR As Range
Dim PicRange As Range, ImageRange As Range
Dim Pic As Picture
Dim image As Shape
Set Game = Sheets("Game")
Set image = Game.Shapes(Game.Range("a13"))
If image.Name Like "*Token*" Then
 If CheckLocation(image) = False Then GoTo Invalid
End If
Exit Sub
Invalid:
MsgBox "A figure already occupies that space, please try again."
Exit Sub
ec:
MsgBox Err.Description
End Sub


' Now the CheckLocation Function

Public Function CheckLocation(image As Shape) As Boolean

Dim Game As Worksheet
Dim TL As Range, BR As Range
Dim PicRange As Range, ImageRange As Range
Dim Pic As Picture



'Assume image.Name Like "*Token*" is checked in calling routine so Then
CheckLocation = True  ' set default value
Set TL = image.TopLeftCell
Set BR = image.BottomRightCell
Set Game = TL.Parent.Parent
Set ImageRange = Game.Range(TL, BR)
For Each Pic In Game.Pictures
    If Pic.Name Like "*Token*" Then
     If Pic.Name <> image.Name Then
       Set PicRange = Game.Range(Pic.TopLeftCell, Pic.BottomRightCell)
       If Not Intersect(PicRange, ImageRange) Is Nothing Then
         CheckLocation = False  ' overlapping locations
         Exit Function
       End If
     End If
    End If
Next Pic
End Function


Note that my approach detects any overlap of cells.  If they have to be perfectly aligned, that could be done with

   If imageRange.Address = picRange.Address then
     CheckLocation = False
     Exit Function
   End if


--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.