Мой отец позвонил мне с вопросом, с которым ему нужна помощь. Он отредактировал полученный документ Word и обнаружил, что не может отправить его по почте, так как он был очень большим. Количество страниц было низким, но были изображения. Я сразу понял, что одно из изображений должно быть большим файлом. Я заставил его удалить изображения одно за другим, пока мы не нашли оскорбительное изображение.
Но должен быть более простой способ сделать это, не так ли?
Ответы:
Для фотографий:
Файл -> «уменьшить размер файла», оттуда вы можете выбрать различные опции, включая сжатие всех или только выбранных изображений. Вы также можете использовать файл для удаления данных обрезанных областей, которые все еще могут быть привязаны к изображениям.
Это не поможет вам идентифицировать оскорбительное изображение, но это быстрый способ сжать все изображения, чтобы исключить их как возможных нарушителей.
Сохраните файл Word .docxкак .zipи откройте папку zip word\media\.
Он покажет размеры файла.
Этот макрос скажет вам PPI каждого изображения и предложит уменьшить или увеличить размер. Я нашел это в сообществе Microsoft. Как отмечалось, макрос был сделан Ричардом Майклсом. К вашему сведению, он вставляет комментарий для каждого изображения, поэтому, если у вас много комментариев, это может привести к беспорядку.
Sub PixelsMatter()
'Created by Richard V. Michaels
'http://www.greatcirclelearning.com
'Creating custom and off-the-shelf productivity apps for Office
On Error GoTo ErrHandler
Dim doc As Word.Document, rng As Word.Range, iRng As Word.Range
Dim shp As Word.Shape, iShp As Word.InlineShape
Dim PixelCount As Integer, FullWidth As Integer, PPI As Integer
Dim Mac As Boolean
Set doc = Word.ActiveDocument
Set rng = Word.Selection.Range
'Check only the range selected, else check entire body of the document
If rng.Start = rng.End Then Set rng = doc.Content
#If Win32 Or Win64 Then
'this is a PC
PixelCount = 96
#Else
'this is a Mac
PixelCount = 72
Mac = True
#End If
For Each iShp In rng.InlineShapes
'only looking for embedded or linked pictures
If iShp.Type = wdInlineShapeLinkedPicture Or iShp.Type = wdInlineShapePicture Then
'determining original width before scaling
FullWidth = iShp.Width / (iShp.ScaleWidth / 100)
'calculate PPI density based on the current scaled size of inserted image
PPI = FullWidth / (iShp.Width / PixelCount)
Select Case PPI
Case Is < 150
iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and will result in poor print quality. " & _
"We suggest either reducing the size of the picture in the document or replacing with a higher quality source image."
Case Is < 200
iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & ", which is marginal for a good print quality. " & _
"We suggest you print a sample and check if the print quality is satisfactory for your needs. " & _
"Higher print quality can be achieved by either reducing picture size or replacing with a higher quality source image."
Case Is < 240
'PPI density is optimal, no comment made
Case Else
iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and does not contribute to better print quality... " & _
"it is only creating a larger than necessary file size for this document. We suggest replacing the image with a more appropriately sized source image."
End Select
End If
Next
If Mac Then GoTo ErrHandler
'With a Mac running Office 2011 there is no need to go further
'The excessively buggy Office 2011 VBA errantly places all "floating" shapes into the inline shapes collection
'No other PC version of Office VBA does this and if the following code is executed on a Mac, double comments
'would be placed on all floating shapes that met the PPI criteria specified in the following Select Case command.
If doc.Shapes.count = 0 Then GoTo ErrHandler
Dim wrapType As Integer, i As Integer
For i = doc.Shapes.count To 1 Step -1
Set shp = doc.Shapes(i)
If shp.Type = Office.MsoShapeType.msoPicture Or _
shp.Type = Office.MsoShapeType.msoLinkedPicture Then
If shp.WrapFormat.Type <> Word.WdWrapType.wdWrapNone Then
wrapType = shp.WrapFormat.Type
Set iShp = shp.ConvertToInlineShape
If iShp.Range.InRange(rng) Then
'determining original width before scaling
FullWidth = iShp.Width / (iShp.ScaleWidth / 100)
'calculate PPI density based on the current scaled size of inserted image
PPI = FullWidth / (iShp.Width / PixelCount)
Select Case PPI
Case Is < 150
iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and will result in poor print quality. " & _
"We suggest either reducing the size of the picture in the document or replacing with a higher quality source image."
Case Is < 200
iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & ", which is marginal for a good print quality. " & _
"We suggest you print a sample and check if the print quality is satisfactory for your needs. " & _
"Higher print quality can be achieved by either reducing picture size or replacing with a higher quality source image."
Case Is < 240
'PPI density is optimal, no comment made
Case Else
iShp.Range.Comments.Add iShp.Range, "PPI is " & PPI & " and does not contribute to better print quality... " & _
"it is only creating a larger than necessary file size for this document. We suggest replacing the image with a more appropriately sized source image."
End Select
iShp.ConvertToShape
shp.WrapFormat.Type = wrapType
Else
iShp.ConvertToShape
shp.WrapFormat.Type = wrapType
End If
End If
End If
Next
ErrHandler:
Select Case Err
Case 0
MsgBox "Action Complete", vbInformation, "Pixels Matter"
Case Else
MsgBox Err.Number & vbCr & Err.Description, vbExclamation, "Pixels Matter"
Err.Clear
End Select
End Sub
Более подробно о замечательном ответе @TommyZG, который лучше всего сработал для меня: вы также можете удалить оскорбительные большие картинки из архива. У меня был случай, когда над файлом работало много людей, и большие картинки «застревали» в файле слов, даже когда они больше не использовались.