Help Editing A Macro

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I use this to load pictures on a sheet. Right now it includes bringing in the file name and putting it below the pictures. I need to disable that part and cannot find the way unless I get an error. Could someone look at this and suggest a way to disable the file name part? Thanks

Code:
Sub LoadPicsLeftToRight()
    On Error GoTo LoadPics_Error
    Application.ScreenUpdating = False


GetParms:
    Do
        startrow = Application.InputBox("Start Images at row: ", , Default:=recstartrow, Type:=1)
        If startrow = False Then GoSub DesireToCancel
    Loop While startrow = False

    Do
        rowshift = Application.InputBox("Place Images with this many rows of separation: ", , Default:=recrowshift, Type:=1)
        If rowshift = False Then GoSub DesireToCancel
    Loop While rowshift = False
    Do
        startcol = Application.InputBox("Start Images at column: ", , Default:=recstartcol, Type:=1)
        If startcol = False Then GoSub DesireToCancel
    Loop While startcol = False
    Do
        colshift = Application.InputBox("Place Images with this many columns of separation: ", , Default:=reccolshift, Type:=1)
        If colshift = False Then GoSub DesireToCancel
    Loop While colshift = False
    Do
        DfltPicHeight = Application.InputBox("The Images should have default height of: ", , Default:=recDfltPicHeight, Type:=1)
        If DfltPicHeight = False Then GoSub DesireToCancel
    Loop While DfltPicHeight = False
    Do
        DfltPicWidth = Application.InputBox("The Images should have default width of: ", , Default:=recDfltPicWidth, Type:=1)
        If DfltPicWidth = False Then GoSub DesireToCancel
    Loop While DfltPicWidth = False
    Do
        DfltColWidth = Application.InputBox("Default Column widths to: ", , Default:=recDfltColWidth, Type:=1)
        If DfltColWidth = False Then GoSub DesireToCancel
    Loop While DfltColWidth = False
    Do
        WrapAtCol = Application.InputBox("Jump to the next row if the image would be placed after column: ", , Default:=recWrapAtCol, Type:=1)
        If WrapAtCol = False Then GoSub DesireToCancel
    Loop While WrapAtCol = False
Process:
    Do
        RootPath = BrowseForFolder
        If RootPath = "False" Then GoSub DesireToCancel
    Loop While RootPath = "False"
    
    If RootPath <> "False" Then RootPath = RootPath & "\"
    LoadHashTable
    If HashTable.Count < 1 Then Exit Sub
    nextrow = startrow
    nextcol = startcol
    KillShapesII    'Deletes all shapes/pictures and text of the active sheet
    With ActiveSheet
        keez = HashTable.Keys              ' Get the keys.
        For i = 0 To HashTable.Count - 1    ' Iterate the array.
            If HashTable.Exists(keez(i)) Then
                picfile = HashTable.Item(keez(i))
                .Cells(nextrow, nextcol).Select
                'Method Insert Shape
                'Set Shp = .Shapes.AddPicture(picfile, msoFalse, msoCTrue, .Cells(nextrow, nextcol).Left, .Cells(nextrow, nextcol).Top, DfltPicWidth, DfltPicHeight)
                .Cells(nextrow, nextcol).RowHeight = Shp.Height
                .Cells(nextrow, nextcol).ColumnWidth = DfltColWidth
                .Cells(nextrow + 1, nextcol) = Replace(Replace(keez(i), ".jpg", ""), ".gif", "")
            End If
            'Determine the column for the next pic
            nextcol = nextcol + 2
            If nextcol > WrapAtCol Then
                nextcol = startcol
                nextrow = nextrow + rowshift
            Else
                nextcol = nextcol
                nextrow = nextrow
            End If
            DoEvents    'Allows computer to process other things in intense loops
        Next i
    End With
    On Error GoTo 0
    Exit Sub
DesireToCancel:
'Manages messaging to user & prog. flow when cancel condition may be present
    swCancel = MsgBox("Do you want to cancel?", vbYesNo)
    Select Case swCancel
        Case Is = vbYes
            MsgBox "Exiting"
            Exit Sub
        Case Is = vbNo
            Return
    End Select
LoadPics_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure LoadPics " & vbLf & picfile
    Err = 0
End Sub
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,450
Office Version
  1. 2010
Platform
  1. Windows
have you tried commenting out this line:
Code:
 '  .Cells(nextrow + 1, nextcol) = Replace(Replace(keez(i), ".jpg", ""), ".gif", "")
 

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I tried this but then I get an error and the code stops. Any other suggestions. Thanks
 

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I have tried all sorts of things, anyone that can edit this?? Thanks
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,450
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

What error do you get and where does it stop?
 

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I cant tell where it stop but I get this and it never loads any pictures.
Error 91(object variable or with lock not set.

https://www.mrexcel.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAXwAAACZCAYAAAAsGYFPAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAABMrSURBVHhe7Z3Ls31HVcfPz4EjRcTCt5ZYJUSSkPiAxFKqEt/ixIET/wFHUUAlBpTgLyAgKoiPiUPHDDJQjPj6VSGa CIhv4QAlojiC1Ax6vjnXr167V57ne6z93nde87tz6e691r9Xat79z7n3HV39r25v2s3n3z81goAAK40D7zuoVUq LffdU WAADgqnH9 vXVjRs3SsF/5qkncggAAK4S73v0sfWC/6of/Z0cXq2uXbuWbTqONrcUKJLpSQmajC23zJGDrimyOmaFqKkpc8RRqayZvTF31LQNh5KbIhMrYXVUzv5o0zFYccua2Vubk1sSplYPOb3Mk4A2EVXTQbCij47mJ1c9y9VmVgNqi568ZIumsuVq0NYcc0c9CwNRUzMctCVhaqVZsPjFilhyU2RiJZydgdb5zeaWAkUyPSlBk7Hlljly0DVFVmf5PsRdXzN7Y 6oaRsOJTdFJlbC6qic/dGmY7DiljWztzYntyRMrR5yepknAW0iqqaDYEUfHc1PrnqWq82sBtQWPXnJFk1ly9WgrTnmjnoWBqKmZjhoS8LUSrNg8YsVseSmyMRKWB2/j0Pwii98biz4X5A1AAC44nCHP1oJq6Ny9kebjsGKW9bM3tqc3JIwtXrI6WWeBLSJqJoOghV9dDQ/uepZrjazGlBb9OQlWzSVLVeDtuaYO pZGIiamuGgLQlTK82CxS9WxJKbIhMr4ewMtM5vNrcUKJLpSQmajC23zJGDrimyOsv3Ie76mtkbc0dN23AouSkysRJWR XsjzYdgxW3rJm9tTm5JWFq9ZDTyzwJaBNRNR0EK/roaH5y1bNcbWY1oLboyUu2aCpbrgZtzTF31LMwEDU1w0FbEqZWmgWLX6yIJTdFJlbC6pj9sVd SbK7cP/9969 /F2PJp87fACAM0BuxLft8gPaFhR8AIBOuDIF/1MfetvqHz701tRPhSd/98GhvyGPAAB2446770090tJbVAv /33it1b/ /HfzKMpz3/011f/PXTh88 d/X5Z96b/MvkU3/ tmS/4TvfnPon/ ytQ38kaTX 7sYvDP0tq0/8qfSHVx//k4dzBADgdPHFfZtCb2y8w49F//nntNAbL3z5a1cvvP21eXR fNP914f yOql393 5gAAcNncfPLx7K3f1fvYHLOPdP7nY1r0n3/uN5L1xDv8/7z5Hu1Pv2f1H0 /O2mf 8i7V5976leT/9knfyVZ4TMf/uXVv/ t9n/7m3dlVfnXv/6l1b/81TtT/ e/fEdWV6tPP/H21T89nvtf/GJWC/Fxzic/ Mjq7z/Y/gFG5GN//ObUjef 6OdXH/3Dn8uj1erZD7xp9cwfSH/j6uZjb8zqavX07z 0evr9D60 8v6fTR0A4NDUCvs2xV5oFvwveukD2ZOir8X Bbf9ZLI1/uvmryX7ojtev3rRna9ffdmdP5XGxmdz0Rc 82Et/F/xrW9IXbCiL8Ve OpXPpT617xKC unn9DC/3X3vil14R9D0ZfHOZ6XvPrh1Te i15tM42j3Se/YAW/tt/4O1Df8fqjh/U/dwcir1w52veuXrFa3TvT/3eg8kCAJwSG /wfdF/wW0/kb3dePFdP7168d0/k0fz2B3 MYmPdF72PfpfCM8Nd/lydy988/et/5dEDbvDBwA4BrVn9ts x599pPPFL3tg6PsV 234qm fFk3/SOeUsTt86Xf98PQRFQDAPsRn9vGZ/lJmC/5lIEVfHudcNPb8/rbhTv 279Xf/PHP8AEALhNf6Ld9fi8crOB/6R2vSzb 0LbGl3 LPtqxH9oKX/lt txbnuHbD20Fe4b/tfeotR/aCl//HfVi/JLv0sI990PbbZ7hv/z79dFO/KHtHT k /Q/tOUZPgAcknhXb7T0FvwtndFKWB2Vsz/adAxW3LJm9tbm5JaEqdVDTi/zJKBNRNV0EKzoo6P5yVXPcrWZ1YDaoicv2aKpbLkatDXH3FHPwkDU1AwHbUmYWmkWLH6xIpbcFJlYCWdnoHV s7mlQJFMT0rQZGy5ZY4cdE2R1Vm D3HX18zemDtq2oZDyU2RiZWwOipnf7TpGKy4Zc3src3JLQlTq4ecXuZJQJuIqukgWNFHR/OTq57lajOrAbVFT16yRVPZcjVoa465o56FgaipGQ7akjC10ixY/GJFLLkpMrESVses/C0dqcvbYn83p/a3dCj4o5WwOipnf7TpGKy4Zc3src3JLQlTq4ecXuZJQJuIqukgWNFHR/OTq57lajOrAbVFT16yRVPZcjVoa465o56FgaipGQ7akjC10ixY/GJFLLkpMrESzs5A6/xmc0uBIpmelKDJ2HLLHDnomiKrs3wf4q6vmb0xd9S0DYeSmyITK2F1VM7 aNMxWHHLmtlbm5NbEqZWDzm9zJOANhFV00Gwoo O5idXPcvVZlYDaouevGSLprLlatDWHHNHPQsDUVMzHLQlYWqlWbD4xYpYclNkYiWsjlkp Jv Ls4mKPg5oFYPlqdWwuqonP3RpmOw4pY1s7c2J7ckTK0ecnqZJwFtIqqmg2BFHx3NT656lqvNrAbUFj15yRZNZcvVoK055o56FgaipmY4aEvC1EqzYPGLFbHkpsjESjg7A63zm80tBYpkelKCJmPLLXPkoGuKrM7yfYi7vmb2xtxR0zYcSm6KTKyE1VE5 6NNx2DFLWtmb21ObkmYWj3k9DJPAtpEVE0HwYo OpqfXPUsV5tZDagtevKSLZrKlqtBW3PMHfUsDERNzXDQloSplWbB4hcrYslNkYmVsDpmf/vBH0l2Vyj4LjdFJlbC6qic/dGmY7DiljWztzYntyRMrR5yepknAW0iqqaDYEUfHc1PrnqWq82sBtQWPXnJFk1ly9WgrTnmjnoWBqKmZjhoS8LUSrNg8YsVseSmyMRKODsDrfObzS0FimR6UoImY8stc Sga4qszvJ9iLu ZvbG3FHTNhxKbopMrITVUTn7o03HYMUta2ZvbU5uSZhaPeT0Mk8C2kRUTQfBij46mp9c9SxXm1kNqC168pItmsqWq0Fbc8wd9SwMRE3NcNCWhKmVZsHiFytiyU2RiZWwOn4fh8AX/JP8LR0AADg8kzt8AAC4elQf6YgFAICrg9R2HukAAHQGBR8AoBMo AAAnUDBBwDoBAo AEAnUPABADqBgg8A0AkUfACATqDgAwB0AgUfAKATKPgAAJ1AwQcA6AQKPgBAJ1DwAQA6gYIPANAJFHwAgE6g4AMAdAIFHwCgEyj4AACdQMEHAOgECj4AQCdQ8AEAOoGCDwDQCRR8AIBO6KbgX7t2LXubWZp3DrSu5dSvccn Dnltl/16HPJaLptz3HPkKlxDi50LvrwosR TTeeZO7fEb926lUfKpvVabJNr7DJnKcdcex/ivlrjaK8qp3h9h9pTXEe zlprX/X3 RzY6w5f3lzfj4V8UPx5/Adnlw/RpvU2IbmnxKntZ1vOff9L6eU65 B1uHwO/kjHimfLCuJbN2p5S5j7EMl6PieOBRnHvVg3WmOvCTW9lidErTYnajUrWK7XhJZuzMWFWo75m bNEderjb0WmctpxVu6sETzY1snajUrWK7XhJZubBOPOXN6jdqcmiZELX49GaZZvvUarRzzoxbzhJpe04SaXsupWUF866fMXgW/dZEybhVZ8637uXHeZVHbn99X6xqibsTxEvw6tr5g54i08lu6EPcb48KmHItFfJ7lxHFENK/bWLrNjWzKsfPEeNQ9FtsGv5bfQ2utVn5LF2ytVtyo5Wyaa1okzqlpS9bZRGstTyvH9uL9mBf1mrYpdw6b433rtu4pcrBHOp65cYtWnujyIlo/BQ6xH7suQay//tb6rdeolT/HrvOE1l7OEbn 1vWc /u0C7XzXPQeWuzzuTvUNcQ9HGrdY3PwRzrHQl5g66eA38 h9yQfmm3W3jbf4 dtO/cqIde 7RfrVX2f7ByyX/ a PNLP0eOdQ3HWvfQnE3BN yLZldkrv8QC/uuGdfbBtvPKXxI9rmOSLyuU7rOFrbHGqe0/0O T5vYdK0XtYdjcqxrOOXX5mDP8JdepH3hWF/6BdTKF83biJ3PM7eHTTGhNT/qUVtKbZ1NbMr3uu3TiPNiXFiSsy/ HNuwaV tfUc9YvElzK0V2ZTvddurEefF CZac70emctv6YaP74Otu2m9JfuSXtM25QotPdJa9xTZueDLRcVuuieOhThHqOV5Yr5h tz8SGue12PM08qp6bU8Ty1mc/zcmOfHPtf0miZEP8YjtZxN UbM2TQW38Zz8wTLt25EP8aFqNfiNWq6rWPdNI8f 1zTa5oQ/Rj3RH3J3JomzOW39Dkspza/hq3r47XcWp5Q02ua4HUfq k bsScU XsHunsgrwJm75DL HUv3MDnAJ8nZw2XRR8Yd8PIR9igHkO9XXC19tx6KbgAwD0zkkV/H0fuwAAQJudC/4xi7Os7btxzHMCAFx1TvaRjjzDs26Fnud6AAC7c/CCX7szF7bVa/ic2ryaBgAAykELvhTa2p25UNNj/lJq83ZdCwCgFy7skY4UZOtL8PlLC/jStQEAeuRCCr4V7W3uvnfNt28SAAAw5WR/aLsrS79BAAD0xl4F3 6m7Y7a32FLt IbdaOlz1Gb58d2XgAAKOxc8KWo m7UNMHrPlbTfdzj9docPwYAgClX7pEOAADUoeADAHQCBR8AoBMuvODbD1kPjf/hbc8c8/qP9RofY88X TmYO9e2e7H8i7yGfTiXfcIeBT yXPjFpIXu mXRW0/wqY9bYodA78/64fkGGsuxV T30dLX0Itd5v5h8Tv3 /h0Ps59HqC3/e26x87H Y5iUc6/jds7LdsLvu3bfx 7IN32XuK D2e2t72pXZtLf8csf1LP9bn69DryT79vrdd/9j5MM FFHz/nVrexCXfuS1HrO elm7U4jG3NbdGXMe64cdeF6Lu4 Jb97T0pbTmt3RDdPuC3pQT14i5No653heWfiY2YWvaOtuuGecLcb6NozVa420/8xHRrfuxJ YI0W/FvdZCcuQ6Wtjafi3zoxUs12seH/O5phmbYrDOzgXff4jF1sZLkXzfI7KWdYuL9XoNH6 tuyutc8dxC5vvfeu2z9Y5PJJjPRLnW07Ud8WvUTt/xOcumScx63P4NaW38Gv6deN8H2thc3bF9rB0Hb837xumRV3wc2LcYvuyzfpxPzWi7vNt/SXrwJQLucOfezP8m3bIN04 ENYNWT9 YGr4uYfckxDX8 fyxHFE1rFeo7XuOTB3bZEl1 jXXLpui9p80WwfYjedw/bg5 yDrGG9Riu aY HoLV a59wXE7iGf4xkA U/6Laln3mbos/l53P/NoX6VL8mtKXYOfy5931/BeFXZ/fc0/INc 9zz7eyrkobA 9vl XyV4F3940 wDFsXFqb2prn6dAfK0Otcdt3gM5p /nwinsVfZwqp8tY9NnoRWz6zok8TU69PqwzqXc4R/iw2NrWI/MxfehtrbX4ti0GjFPxkJNi/gc6Z7WulHfFb/GIda2uYZfZ24tn2d7EeKaLeK bY2o70Pci1/Xzrcrc/uM8V3PF9eRvgt /tK91ObE/cA8exf8 IbV3sBNb2orZvqm9cX33TSjFhf8h6ZGK Z1W7OmGT7HdB83Yo5Q0zw 7vPMCjFmtHRhk at755azOe0fI/N9d1TG9fyPLWY11preN1itRxj7rMl2FrWDfNbVtjk 26aEWOC95fi17H5cZ0lunVPHHs2zanpUOfKPsMHgO1Y8s3qoli6F8mzTtGf59IK/mW OXwwTpNjvC8X/V5vOt pf 5OaX9 L3OvqXWYhzt8AIBOoOADAHQCBR8AoBMo AAAnUDBBwDoBAo AEAnUPABADqBgg8A0AkUfACATqDgAwB0AgUfAKATKPgAAJ1AwQcA6AQKPgBAJ1DwAQA6gYIPANAJFHwAgE6g4AMAdAIFHwCgEyj4AACdQMEHAOgECj4AQCdcu/nk47duv ue1TNPPZElAAC4Srzv0cdWN27c4A4fAKAXKPgAAJ1AwQcA6AQKPgBAJ1DwAQA6gYIPANAJFHwAgE6g4AMAdAL/4xUAnBx33H1v9mCOoYZnrw3/4xUAnDS3bt2ib j33XdffqWWwx0 AJwccocvRY26VMfu2KVzhw8AAGtQ8AEAOoGCDwDQCRR8AIBOoOADAATkh8bWPXPjU4eCDwDgkCIuv/livVXULe coOADAGRqRbxW9M x2AsUfACALTjXYi9Q8AEAOoGCDwCwBbVHPOcCBR8AILP0ef25Fn0KPgCAw4q59VjsjXMs hR8AICAFHPrnrnxqUPBBwDoBAo AEAnUPABADqBgg8A0An8i1cAcHLIb7/Iv3h1/fr1rEBkl3/xioIPACeHFPxd/s3W3qDgA8DZc26/336ZUPABAGCEf8QcAKAzKPgAAJ1AwQcA6AQKPgBAJ1DwAQA6gYIPANAJFHwAgE6g4AMAdAIFHwCgEyj4AACdkP60gvxvtwAAcHVJf0vnvvvuu5XHAABwZVmt/h/2v8KuxMstVwAAAABJRU5ErkJggg==
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,450
Office Version
  1. 2010
Platform
  1. Windows
All I can suggest is that you use F8 to step through it and see what happens
 

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I stops somewhere new everytime I make a change. Nothing seems to work. Thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,108,806
Messages
5,524,987
Members
409,614
Latest member
wile2u

This Week's Hot Topics

Top