none
Insert Object Assistance RRS feed

  • Question

  • Greetings - 

    I have a lil code I am needing some assistance with. The below code is supposed to insert an object in a particular cell. If the first cell is taken, the code should insert any additional objects into the next referenced cell. This is being done in order to allow multiple files to be added to the sheet, without overlapping the objects. If the first cell is occupied by an object, it should go to the next cell, etc...

    While I am unable to tell the system that there is an object in the cell, I am placing a marker (a period in this case ".") so-to-speak in the cell. If the cell is populated with the marker, it should seek the next available cell to place any additional objects (files).

    The first two portions of the below code works great. The code gets held up in a way when seeking a 3rd available cell. The code always seems to point back to the second portion (cell B2), even if there is the marker (".") in cell B2? I can cancel when cell B2 is actually selected, and then it will move onto the next cell (C2) as defined in the code.

    So I guess my first question would be...is there a better way of doing this? Or...is there something I am missing in my code?

    Any suggestions will be greatly appreciated. Thank in advance :)

    Private Sub Attach2_Click()

        ActiveWindow.DisplayWorkbookTabs = False

        Sheets("Attachments").Visible = True

        Sheets("Attachments").Select

        ActiveSheet.Unprotect Password:=""

       

        If Sheets("Attachments").Range("A2").Value = "" Then

        Sheets("Attachments").Range("A2").Select

        Sheets("Attachments").Range("A2").Value = "."

        Application.Dialogs(xlDialogInsertObject).Show

       

        ElseIf Sheets("Attachments").Range("A2").Value = "." Then

        Sheets("Attachments").Range("B2").Select

        Sheets("Attachments").Range("B2").Value = "."

        Application.Dialogs(xlDialogInsertObject).Show

       

        Else

       

       If Sheets("Attachments").Range("B2").Value = "." Then

                    ‘ If Sheets("Attachments").Range("A2").Value = "." And Sheets("Attachments").Range("B2").Value = "." Then

        Sheets("Attachments").Range("C2").Select

        Sheets("Attachments").Range("C2").Value = "."

        Application.Dialogs(xlDialogInsertObject).Show

       

        End If

        End If

    End Sub

    Tuesday, February 16, 2016 7:07 PM

Answers

  • Re:  finding empty cell to insert object

    How many objects (max) are you going to insert?

    If it is N then a loop thru row 2 looking for a blank cell should do it...

    Sub Sub Attach2_Click()
      Dim C As Long
      Dim N As Long
      Dim bFound As Boolean

      N = 100
      For C = 1 To N
      If VBA.Len(Sheets("Attachments").Cells(2, C).Value) < 1 Then
        Sheets("Attachments").Cells(2, C).Value = "."
        Sheets("Attachments").Cells(2, C).Select
        bFound = True
        Exit For
      End If
      Next 'C
      If bFound Then Application.Dialogs(xlDialogInsertObject).Show
    End Sub

    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Marked as answer by rstreets2 Thursday, February 18, 2016 8:05 PM
    • Edited by James Cone Tuesday, November 1, 2016 12:42 AM
    Wednesday, February 17, 2016 3:49 AM
  • >>>I have a lil code I am needing some assistance with. The below code is supposed to insert an object in a particular cell. If the first cell is taken, the code should insert any additional objects into the next referenced cell. This is being done in order to allow multiple files to be added to the sheet, without overlapping the objects. If the first cell is occupied by an object, it should go to the next cell, etc...

    According to your description, you could refer to codes below:

    Sub DemoInsertObject()
        Application.ScreenUpdating = False
        
            Dim cell As Range
            Dim isFound As Boolean
    
            ' loop each cell in column A
            For Each cell In Range("A2", Range("A2").End(xlToRight))
                 ' make sure the cell is . before doing any work
                 If cell = "" Then
                    isFound = True
                    Exit For
                End If
            Next
            
            ' create and insert a new OleObject based on the path
            Dim ol As OLEObject
            Set ol = ActiveSheet.OLEObjects.Add( _
                                                Filename:="D:\calculate.xlsx", _
                                                Link:=False, _
                                                DisplayAsIcon:=True, _
                                                Height:=10)
            With ol
                 .ShapeRange.LockAspectRatio = msoFalse
                 .Top = cell.Top
                 .Left = cell.Left
                 .Width = cell.Width
                 '.Height = cell.Height
            End With
        Application.ScreenUpdating = True
    End Sub
    

    For more information, click here to refer about OLEObjects.Add Method (Excel)

    • Marked as answer by rstreets2 Thursday, February 18, 2016 8:05 PM
    Wednesday, February 17, 2016 6:59 AM

All replies

  • Re:  finding empty cell to insert object

    How many objects (max) are you going to insert?

    If it is N then a loop thru row 2 looking for a blank cell should do it...

    Sub Sub Attach2_Click()
      Dim C As Long
      Dim N As Long
      Dim bFound As Boolean

      N = 100
      For C = 1 To N
      If VBA.Len(Sheets("Attachments").Cells(2, C).Value) < 1 Then
        Sheets("Attachments").Cells(2, C).Value = "."
        Sheets("Attachments").Cells(2, C).Select
        bFound = True
        Exit For
      End If
      Next 'C
      If bFound Then Application.Dialogs(xlDialogInsertObject).Show
    End Sub

    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Marked as answer by rstreets2 Thursday, February 18, 2016 8:05 PM
    • Edited by James Cone Tuesday, November 1, 2016 12:42 AM
    Wednesday, February 17, 2016 3:49 AM
  • >>>I have a lil code I am needing some assistance with. The below code is supposed to insert an object in a particular cell. If the first cell is taken, the code should insert any additional objects into the next referenced cell. This is being done in order to allow multiple files to be added to the sheet, without overlapping the objects. If the first cell is occupied by an object, it should go to the next cell, etc...

    According to your description, you could refer to codes below:

    Sub DemoInsertObject()
        Application.ScreenUpdating = False
        
            Dim cell As Range
            Dim isFound As Boolean
    
            ' loop each cell in column A
            For Each cell In Range("A2", Range("A2").End(xlToRight))
                 ' make sure the cell is . before doing any work
                 If cell = "" Then
                    isFound = True
                    Exit For
                End If
            Next
            
            ' create and insert a new OleObject based on the path
            Dim ol As OLEObject
            Set ol = ActiveSheet.OLEObjects.Add( _
                                                Filename:="D:\calculate.xlsx", _
                                                Link:=False, _
                                                DisplayAsIcon:=True, _
                                                Height:=10)
            With ol
                 .ShapeRange.LockAspectRatio = msoFalse
                 .Top = cell.Top
                 .Left = cell.Left
                 .Width = cell.Width
                 '.Height = cell.Height
            End With
        Application.ScreenUpdating = True
    End Sub
    

    For more information, click here to refer about OLEObjects.Add Method (Excel)

    • Marked as answer by rstreets2 Thursday, February 18, 2016 8:05 PM
    Wednesday, February 17, 2016 6:59 AM
  • Thank you both David and James for your assistance with this. I really appreciate the time you spent :) I did play with this a little and did get it to work; however I did opt to go with another solution that actually provided me a little more control. I decided to create a grid of sort with a button to add a file into each cell individually. Below is what I used...This will also allow users to delete a file if necessary (via another button)...lol...which I will be seeking some assistance on in a future post (coming soon :))<o:p></o:p>

    I may seek some assistance on actually deleting the files that are placed into their respective locations (cells) as I have been having some difficulties actually selecting the file/object once inserted/placed into its respective location/cell. If you guys have any suggestions on how I might be able to accomplish that task, that would be terrific! Otherwise I will go ahead and create a separate post if I am unable to figure out.<o:p></o:p>

    Private Sub Attach1_Click()


    '''''''''''''''''''''''''''''''''''''''''''''''
    ' Inserts 1st file into sheet 
    '''''''''''''''''''''''''''''''''''''''''''''''

        ActiveWindow.DisplayWorkbookTabs = False
        Sheets("Attachments").Visible = True
        Sheets("Attachments").Select
        ActiveSheet.Unprotect Password:=""

        Sheets("Attachments").Range("A2").Select
        Application.Dialogs(xlDialogInsertObject).Show
        ActiveSheet.Attach1.Visible = False

    End Sub

    Thanks again for both of your assistance :)

     
    Thursday, February 18, 2016 7:41 PM