We help IT Professionals succeed at work.
Troubleshooting Question

Copying and Pasting as Pictures using VBA

64 Views
Last Modified: 2020-10-28
TestPlan.xlsmI am a teacher and have written some basic VBA to enable me to create seating plans for classes of students from stand-alone data in Excel. I am a novice when it comes to VBA and computer programming generally and probably for that reason, my code doesn't run as intended on my Windows-based laptop (though it might run more successfully on my PC).

I know that there is software out there that does this job, running from a School's central database but, for a few reasons, I don't want to use third party software.

The intention is to copy and paste - as a picture - a range of cells from one sheet to another and name the picture in a sequence, ie. "Picture 2101", "Picture 2102", etc.  The range to copy moves along a sheet called "Cards Static" and then goes onto the next row of 8 students.

The pictures or 'cards' can then be moved around a sheet as needed.

I fully accept that I don't really know what I am doing and that the existing code is untidy.  I've commented out various parts of the code while trying to establish what is currently causing it to crash after creating 5 cards.

Any help appreciated! 
Comment
Watch Question

Roy CoxGroup Finance Manager
CERTIFIED EXPERT

Commented:
To add an attachment you will see below the reply box a paper clip icon and "Attach File". This opens a dialog to browse for your file. It's best to attach the file directly because it will remain whereas if you delete it from your Google Drive it will disappear here.
Roy CoxGroup Finance Manager
CERTIFIED EXPERT

Commented:
Which sheet are you copying from?

Author

Commented:
Hi Roy

File uploaded.  Sorry that I didn't remember that uploading a file was straightforward.

From the "Cards Static" sheet and pasting to Nov20_1.

Thanks
Ben
Roy CoxGroup Finance Manager
CERTIFIED EXPERT

Commented:
I've had a look at your workbook and your code and I don't understand what you are copying and where to.
Roy CoxGroup Finance Manager
CERTIFIED EXPERT

Commented:
Your destination sheet contains shapes so I cant imagine how you will copy and paste over them

Author

Commented:
I've copied a few 'cards' manually so you can see the idea.

TestPlan.xlsm

I want to automate it so that when the information in the original worksheet changes, it is easy to update the cards on the Nov20_1 sheet.
I hope that makes sense.

byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
From an overall perspective, I suggest putting the student list as a Table in the worksheet with the seating chart. You may then use the same code to produce seating charts for different classes.

When you declare variables, each variable must be declared as something. If you don't, that variable will be a Variant.
Dim x, rownumber, columnnumber As Single   'x and rownumber are Variant
Integer and Single were designed for 16-bit computers. You should be using Long and Double instead with modern computers to avoid potential overflow problems. The statement above should be using Long as variables are integers.
Dim x As Long, rownumber As Long, columnnumber As Long
I revised your code as follows. The students don't line up with the Rectangle objects used as tables, and the data still comes from worksheet Cards Static, but it's enough to begin a discussion.
Sub UpdatePlan()
AdminDeleteAllStudents
AdminCreateNewPictures
End Sub


Sub AdminDeleteAllStudents(Optional b As Boolean)
Dim shp As Shape
Dim seatingPlan As String
Dim x As Long

seatingPlan = ActiveSheet.Name
'seatingplan = InputBox("Which seating plan?", "Selecting Seating Plan", currentsheet)
Sheets(seatingPlan).Unprotect

On Error Resume Next
For x = 1 To 40

    'Sheets(seatingplan).Activate
    Set shp = ActiveSheet.Shapes("Picture " & x + 2100)
    If Not shp Is Nothing Then shp.Delete
   ' MsgBox ("Done")
Next x

End Sub

Sub AdminCreateNewPictures(Optional b As Boolean)

Dim x As Long, rownumber As Long, columnnumber As Long
Dim seatingPlan As String
Dim shp As Shape
Dim rg As Range


#If Mac Then
    studentwidth = 148
#Else
    studentwidth = 126
#End If




'studentwidth = 126

rownumber = 2
columnnumber = 2

seatingPlan = ActiveSheet.Name
'seatingplan = InputBox("Which seating plan?", "Selecting Seating Plan", currentsheet)
Sheets(seatingPlan).Unprotect

x = 1
For rownumber = 2 To 26 Step 6

    For columnnumber = 2 To 44 Step 6
    'Sheets(seatingplan).Select
    
        With Sheets("Cards Static")
            Set rg = .Range(.Cells(rownumber, columnnumber), .Cells(rownumber + 4, columnnumber + 4))
            If rg.Cells(1, 1).Value = "" Then
                Set rg = Nothing
            End If
        End With
        'Sheets(seatingplan).Activate
        
        If Not rg Is Nothing Then
             rg.Copy
             ActiveSheet.Pictures.Paste.Select
             Set shp = ActiveSheet.Shapes(Selection.Name)
             shp.Name = "Picture " & (x + 2100)
            ' Selection.Locked = msoFalse
             shp.LockAspectRatio = msoFalse
             'Selection.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
             'Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
             
             With shp
                 .Width = studentwidth
                 .Height = 102
                 .Top = rownumber * 18
                 .Left = columnnumber * 22
                 '.Formula = ""
             End With
        End If
    
        x = x + 1
        
        'MsgBox ("Done 1")
    
    Next columnnumber

Next rownumber

'Sheets(currentsheet).Cells(2, 8) = "Detail View"

'Sheets(currentsheet).Protect
MsgBox ("Updates Complete")

Exit Sub
MsgBox ("Error Encountered")

End Sub
SeatingChartQ29198549.xlsm

Author

Commented:
Thank you, byundt.  That's promising.

I appreciate the polite way you correct my defining of variables.

I am not worried that the 'cards' are generated as a grid.  The idea is that they are then slid into place.

I like the neatening up of the code which will no doubt improve its efficiency.

Slightly unexpected, it doesn't run all the way through when I run it on my laptop.  On running it four times, it crashed after generating 5, 6, 23 and 5 cards.  I don't know why.  I bet it would work fine on my desktop.

Do you have any idea what might cause that?

Thank you once again.
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
I encountered a non-reproducible (and inexplicable) error on statement 69 (pasting and then selecting a shape). The debugger is your friend when it comes to identifying the problem because you can investigate the state of the relevant variables.

I'm using Windows Excel (Microsoft 365) on a MacBook Pro. I have other versions of Excel (Windows and Mac) available for testing. Which version are you using?

Brad

Author

Commented:
Thanks, Brad.

Hopefully there is a pic below showing the version I am using.


Author

Commented:
Maybe this has something to do with it?

https://office-watch.com/2019/windows-update-causes-office-vba-to-fail/

But I don't understand enough to know if there is a workaround.
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
I found that when the runtime error occurred, the statement would work if I tried to execute it a second time. So I automated that "repeat" action.
Sub AdminCreateNewPictures(Optional b As Boolean)

Dim nShapes As Long, x As Long, rowNumber As Long, columnNumber As Long
Dim seatingPlan As String
Dim shp As Shape
Dim rg As Range


#If Mac Then
    studentwidth = 148
#Else
    studentwidth = 126
#End If




'studentwidth = 126

rowNumber = 2
columnNumber = 2

seatingPlan = ActiveSheet.Name
'seatingplan = InputBox("Which seating plan?", "Selecting Seating Plan", currentsheet)
Sheets(seatingPlan).Unprotect

x = 1
For rowNumber = 2 To 26 Step 6

    For columnNumber = 2 To 44 Step 6
    'Sheets(seatingplan).Select
    
        With Sheets("Cards Static")
            Set rg = .Range(.Cells(rowNumber, columnNumber), .Cells(rowNumber + 4, columnNumber + 4))
            If rg.Cells(1, 1).Value = "" Then
                Set rg = Nothing
            End If
        End With
        'Sheets(seatingplan).Activate
        
        If Not rg Is Nothing Then
             rg.Copy
             nShapes = ActiveSheet.Shapes.Count
             On Error Resume Next
             ActiveSheet.Pictures.Paste     'This statement sometimes produces a runtime error
             If Err <> 0 Then
                Err.Clear
                ActiveSheet.Pictures.Paste
             End If
             On Error GoTo 0
             
             Set shp = ActiveSheet.Shapes(nShapes + 1)
             shp.Name = "Picture " & (x + 2100)
            ' Selection.Locked = msoFalse
             shp.LockAspectRatio = msoFalse
             'Selection.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
             'Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
             
             With shp
                 .Width = studentwidth
                 .Height = 102
                 .Top = rowNumber * 18
                 .Left = columnNumber * 22
                 '.Formula = ""
             End With
        End If
    
        x = x + 1
        
        'MsgBox ("Done 1")
    
    Next columnNumber

Next rowNumber

'Sheets(currentsheet).Cells(2, 8) = "Detail View"

'Sheets(currentsheet).Protect
MsgBox ("Updates Complete")

Exit Sub
MsgBox ("Error Encountered")

End Sub

Author

Commented:
Well, that seems to get through the rest of the code for us.  Thank you.

I'll accept this as a solution in a day or two in case someone can find an even cleaner option in the meantime.

Author

Commented:
Hate to say it, but it is still falling over. (I took the Optional b as Boolean out as I couldn't then see the macro to run it).

Sorry.


byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
The attached workbook is what I had in mind. There is one visible macro, and it calls subs to delete the existing desks, then add new ones based on values in a Table. In so doing, each worksheet is independent from all other worksheets used to produce seating charts.

I added a loop to try up to four times to paste the student's desk. You may increase the maximum value if you still have issues.

Sub UpdatePlan()
Application.ScreenUpdating = False
AdminDeleteAllStudents
AdminCreateNewPictures
End Sub


Sub AdminDeleteAllStudents(Optional b As Boolean)
Dim shp As Shape
Dim seatingPlan As String
Dim x As Long

seatingPlan = ActiveSheet.Name
Sheets(seatingPlan).Unprotect

On Error Resume Next
For x = 1 To 40
    Set shp = ActiveSheet.Shapes("Picture " & x + 2100)
    If Not shp Is Nothing Then shp.Delete
Next x
On Error GoTo 0

End Sub

Sub AdminCreateNewPictures(Optional b As Boolean)

Dim nShapes As Long, nStudents As Long, x As Long, rowNumber As Long, columnNumber As Long, try As Long
Dim studentWidth As Single
Dim seatingPlan As String
Dim shp As Shape
Dim Desk As Range, Student As Range, Students As Range


#If Mac Then
    studentWidth = 148
#Else
    studentWidth = 126
#End If


rowNumber = 2
columnNumber = 2

With ActiveSheet
    seatingPlan = .Name
    .Unprotect
    Set Students = .ListObjects(1).DataBodyRange
    nStudents = Students.Rows.Count
End With
Set Desk = Worksheets("Cards Static").Range("B2:E5")

x = 1
For rowNumber = 2 To 26 Step 6

    For columnNumber = 2 To 44 Step 6
        Set Student = Students.Rows(x)
        UpdateDesk Student, Desk
             
        Desk.Copy
        nShapes = ActiveSheet.Shapes.Count
        On Error Resume Next
        For try = 1 To 4
            ActiveSheet.Pictures.Paste     'This statement sometimes produces a runtime error
            If Err = 0 Then Exit For
            Err.Clear
            ActiveSheet.Pictures.Paste
        Next
        On Error GoTo 0
        
        Set shp = ActiveSheet.Shapes(nShapes + 1)
        shp.Name = "Picture " & (x + 2100)
        shp.LockAspectRatio = msoFalse
        
        With shp
            .Width = studentWidth
            .Height = 102
            .Top = rowNumber * 18
            .Left = columnNumber * 22
        End With
    
        x = x + 1
        If x > nStudents Then Exit For
        
    Next columnNumber
    If x > nStudents Then Exit For
Next rowNumber

End Sub

Sub UpdateDesk(Student As Range, Desk As Range)
With Desk
    .Cells(1, 1).Value = IIf(Student.Cells(1, 1).Value = "", "", Student.Cells(1, 1).Value)
    .Cells(2, 1).Value = IIf(Student.Cells(1, 2).Value = "", "", Student.Cells(1, 2).Value)
    .Cells(3, 1).Value = IIf(Student.Cells(1, 3).Value = "", "", Student.Cells(1, 3).Value)
    .Cells(3, 2).Value = IIf(Student.Cells(1, 4).Value = "", "", Student.Cells(1, 4).Value)
    .Cells(3, 3).Value = IIf(Student.Cells(1, 5).Value = "", "", Student.Cells(1, 5).Value)
    .Cells(3, 4).Value = IIf(Student.Cells(1, 6).Value = "", "", Student.Cells(1, 6).Value)
    .Cells(4, 2).Value = IIf(Student.Cells(1, 7).Text = "", "", Student.Cells(1, 7).Text)
    .Cells(4, 3).Value = IIf(Student.Cells(1, 8).Text = "", "", Student.Cells(1, 8).Text)
    .Cells(4, 4).Value = IIf(Student.Cells(1, 9).Value = "", "", Student.Cells(1, 9).Value)
End With
End Sub

SeatingChartQ29198549.xlsm
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
BTW, it's OK if you want to delete the optional Boolean parameter b in subs AdminDeleteAllStudents or AdminCreateNewPictures. I put it in there specifically to prevent those subs from showing up in the ALT + F8 macro selector. If you keep the optional parameter, you may still run the macro using the ALT + F8 macro selector--you just need to type the name of the macro in that dialog.

Author

Commented:
Hi Brad.
I am very grateful for your continued effort on this.
I downloaded your latest solution and unfortunately it didn't work on my laptop.
And then after pressing 'End'


When I then re-ran it, and pressed 'Debug', the error occurred in the line you'll see below:

Running it on my desktop PC also gave errors. I'll outline these in a further message if helpful.

I am so sorry that the time you've invested hasn't, as yet, given a solution.  I'd understand if you said that the main issue is with the version of Windows I am using on my laptop.  I am also worried that we are moving further away from the original problem and that it is creating more and more work for you.

If you wanted to concede defeat, I'd understand.

Thanks again for your efforts so far.
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
It's clear (at least to me) that we are dealing with either a bug in Excel VBA or else a bit of file corruption. Either way, we will get to the bottom of the issue.

I am posting two workbooks. Please try both of them, and let me know what you find.

The first was created from scratch, and is intended solely to test whether you have a reproducible issue with VBA. Run the code a number of times to see if the VBA problem occurs. If it is a reproducible problem, I will reach out to Microsoft to investigate.
Original Seating Chart.xlsm

The second is my latest attempt at slapping a plaster over the problem. The code now allows your latest reported error to occur, and makes note of it in the data table.
SeatingChartQ29198549.xlsm 

If the error does not occur in Original Seating Chart.xlsm but does in SeatingChartQ29198549.xlsm, the problem is likely to do with file corruption. If so, I suggest recreating the file from scratch. You may use the code with the plaster if you do so--it won't harm macro execution or results if the underlying problem is fixed.

If we get to successfully working code, I'd like to add a feature in which the student's seating position is listed in the Table, with both table number and left or right position. I suspect this would make your job much easier if you need to tweak seating positions for students who are added or dropped in the middle of school year.

Author

Commented:
I admire your tenacity! Thank you..

Okay, so when I click the button on Original Seating Chart.xlsm, I get the error below.  On clicking 'End' I see that a few cards (about 5) have been created.  I press it again and a couple more cards get created.

Pressing it a third time resulted in 15 cards.  And a fourth time produced all the cards.

Then it was a similar pattern when pressing it several more times.

Author

Commented:
With the sticking plaster solution, I don't get any crashes but I do get random gaps in the cards created.


What should I do next?
Mechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

Commented:
The Range.CopyPicture method seems to be doing the trick.  It is slower, but that is immaterial to me.

Great news.  I shall have a further test tomorrow with that and let you know.  Very encouraging.  Thank you!!

Author

Commented:
Dear Brad

Please accept my apologies for not responding sooner than now.

I have tested the code at various times over the course of the day, ultimately with success!  It worked perfectly in your workbook SeatingChartQ29198549.xlsm so you had overcome the issues that I'd had already by this morning. But I wanted to adopt it within the old seating plan sheets I had.

It's a long story, but the eight boxes under a student's name are supposed to be able to vary depending on which attributes I want showing for a particular class.

It seems to work!  The "error routine" you've come up with seems to workaround the crashing or omitting certain 'cards'.
I've put in a 'sleep' command which seems to give the pastespecial time to do its job (alongside your error routine).

Unfortunately, my amateur code tarnishes the neat code you've provided but I'm pleased with the functionality it gives me.  I would send it through to you now, but the seating plans are now part of a much bigger workbook (with genuine data which I need to strip out) and all the macros are in a separate workbook with lots of other little routines.

However, I feel I owe it to you to offer to put it into a format that you can see and I'll do this for you by tomorrow. Forgive me for not using everything you have provided but you've given me what I seem to need to have something that now works on my laptop.

Thanks for your efforts and patience with me.

byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
My sister-in-law is an elementary school teacher, and was impressed by your perseverance in building a tool for seating charts. She still uses the "pencil and paper" way of doing things and will be retiring in June, but could definitely see the benefit of automating it.

I removed the Windows API function you used for Sleep because it is 32-bit and I run 64-bit Excel. If you nee to keep that routine, you can handle both possibilities using Conditional Compilation, like you did for Mac versus Windows Excel.

If you need me to look at your actual workbook, I'd be glad to do so and can be reached as byundt at my ISP, which is alum dot mit dot edu.

Should you need further assistance implementing the suggestions made so far in this thread, please keep posting here. Although it is possible to unsubscribe from a thread, I never do so and have 40 to 80 posts in some threads.

Brad

Author

Commented:
Hi Brad

Thanks again for your help and sincere apologies in advance for the code you might see in the edited workbook attached..

I am in a secondary School in the UK and I know there are tools available to us that automate seating plans.  But I like the flexibility of being able to choose (and format) any student attribute to appear on a seating plan.

You'll probably work out that my originating table is the sheet "Class".  This feeds through to "Cards" where I can select any attribute (most of which I've deleted for understandable reasons).  Clicking the big button copies this data through to "Static Cards" which is hidden, not that it needs to be.  And that's where the seating plans takes its cards (or 'tiles', as I often call them as they can slide around the seating plan layout giving the flexibility that I want).

The macros for the various buttons on the Seating Plan sheet are now in this example workbook so you'll see how I mess about with layout when I need to.  You might note the "Name Only" option which is usually the version that I display for students to see.

I am interested in the alternative to the "sleep" command as I think I am running 64-bit Excel too!  Maybe my Sleep500 is doing nothing?!

I don't expect you to do anything other than sigh at my dodgy code but if you see any glaringly obvious improvements, feel free to let me know!  Apologies it is not the full version and there are bits that won't make sense without further explanation.

Test (2020) Tracking Sheet.xlsm
 
And thank you again to you for your help and to your sister-in-law for her years in education!
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
Ben,
Did you know that VBA has a function to reverse the character sequence in a string?
BackwardsText = strReverse(text)
I suggest that you check the box for "Require Variable Declaration" in the Tools...Options...Editor ribbon item in the VBA Editor. When you do that, you will need to put every variable in a Dim statement. It's a good habit to get into because it will speed up your code while reducing the number of logic errors you need to debug (because VBA knows you are working with s String, Long, Double, Range or Worksheet). It will also help you catch typos in variable names because they won't have been declared.

In the meantime, you should consider putting "Option Explicit" at the top of each module sheet. The "Require variable Declaration" setting will insert "Option Explicit" for you automatically on newly created modules, but not on existing ones.

I also suggest that you name variables with a capital letter. That way, if you are reading your code and don't see a capital letter, you know that variable name is either misspelled or hasn't been declared.

In sub DetailViewPC, you call the Sleep function before using CopyPicture and PasteSpecial. I'm pretty sure one of those two statements is the one that might need extra time to finish, so you should move the Sleep function after it.

As a general rule, you should try to eliminate all statements that .Select or .Activate a cell or worksheet. Selecting or Activating really slows macro execution down, and is almost never necessary in good VBA code. I might need to Select or Activate object only 5 to 10 times a year, typically for something like creating conditional formatting or grouping multiple worksheets so you can make changes on all of them simultaneously.
    'Bad practice
Sheets("Cards").Select
Sheets("Cards").Cells(currentcellrow, currentcellcolumn).Copy

     'Good practice
Sheets("Cards").Cells(currentcellrow, currentcellcolumn).Copy

Brad



Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions