Posts by JamMar001

I wrote this in Word originally for a Work stream where file upload limit to a client database is only 4MB, it should be easy to code into Excel. Took me 8 months to write, as nothing online for this, and no code to directly code it - when you are desperate for a solution to compliment other timesaving macros, it seems, you can almost come up with any work around, just have to be brutal to just get it to work. Notes are mostly taken out of the code. First bit is in case QAT is pressed in error with no file open. SendKeys is entered twice to stop my USB numberpad from being toggled off or back on, if an odd number of images are compressed. No way to stop the Command bar from flickering. I have created test macros to detect if apply only to this picture is selected or not, so you can ensure the compression is not looped through every image. But I am not sensitive to strobing, and only compress up to 30 images at a time. If more it might cause an unnecessary delay, to loop through every image. You can add delay code between the first loop to call up the compression Command Bar, and the loop for remaining images, and at the end of the second loop, if strobing is a problem, I have a second QAT copy of this for Macro c, for 96ppi:

Sub MacroC_28_06_2022()

'150ppi SOURCE: [email protected]

Word.Application.ScreenUpdating = False

If Word.Application.Documents.Count = 0 Then

Exit Sub

End If

Dim oIlS As inlineshape

If Word.ActiveDocument.Inlineshapes.Count > 0 Then

Word.ActiveDocument.Inlineshapes(1).Select

VBA.SendKeys "%W{ENTER}", True

Application.Commandbars.ExecuteMso ("PicturesCompress")

DoEvents '''28/06/2022 Add SendKeys for a 2nd time each time used to undo toggling off the NumLock

VBA.SendKeys "%W{ENTER}", True

Application.Commandbars.ExecuteMso ("PicturesCompress")

For i = 2 To Word.ActiveDocument.Inlineshapes.Count

If Word.ActiveDocument.Inlineshapes.Count > 1 Then

Word.ActiveDocument.Inlineshapes(i).Select

VBA.SendKeys "%W{ENTER}", True

Application.Commandbars.ExecuteMso ("PicturesCompress")

DoEvents '''2nd running to toggle numlock back on

VBA.SendKeys "%W{ENTER}", True

Application.Commandbars.ExecuteMso ("PicturesCompress")

End If

Next i

Word.Application.ScreenUpdating = True

End Sub

Just a statistical observation. Might not be considered statistically random if the distribution of numbers is predetermined, so there is error here if stating random numbers are being used. But if needed for random allocation to say 100 staff members, I guess this is ok.

If you want to code a particular sequence of awkward menus, you can use:

Application.Commandbars.ExecuteMso "PicturesCompress" '20-05-2022 Can add brackets around the speech marks

If you want to see the complete list of menus you can call up with ...ExecuteMso

On the down chevron above the Ribbon, select more commands, on the pop up menu , and change the top drop-down menu to all commands, if you find the icon you want to use, you use the phrase in brackets in speech marks using the example code above exactly, but with you brackets text in the speech marks.

Used this recently for header and footer deletions as could not code any other way.

I had to use this technique when struggling to compress all images in a document, had to use SendKeys at the end to do the 150ppi compression. (Had to use DoEvents and repeat the SendKeys a my USB numberpad was toggling off or on via odd number of image compressions.

I have had help from gregmaxey.com for userforms, a bit of a dark art to me, and can't advise on that method.