Napisałeś obszerny dokument (np. książka) w Wordzie, który będzie w wydruku czarno-białym? Chcesz przekonwertować wszystkie załączone rysunki które są kolorowe na rysunki w skali szarości? Tutaj wystarczy proste makro, które wykona tę czynność za Ciebie:
Sub SzaroscWord()
Dim i As Integer
For i = 1 To ActiveDocument.InlineShapes.Count
If ActiveDocument.InlineShapes.Item(i).Type = wdInlineShapePicture Then
ActiveDocument.InlineShapes.Item(i).PictureFormat.ColorType = msoPictureGrayscale
End If
Next i
For i = 1 To ActiveDocument.Shapes.Count
If ActiveDocument.Shapes.Item(i).Type = msoPicture Then
ActiveDocument.Shapes.Item(i).PictureFormat.ColorType = msoPictureGrayscale
End If
Next i
End Sub
Dlaczego są tutaj dwie pętle For? Otóż w Wordzie mogą być dwa rodzaje obrazów: osadzone wewnątrz akapitu i pływające.
Natomiast możemy podobne makro zastosować w Excelu. W Excelu z oczywistych względów nie ma czegoś takiego jak obrazy osadzone wewnątrz akapitu, mamy tam tylko obrazy pływające, więc i kod będzie nieco krótszy.
Sub SzaroscExcel()
Dim Arkusz As Integer
Dim i As Integer
With ThisWorkbook
For Arkusz = 1 To .Sheets.Count
For i = 1 To .Sheets(Arkusz).Shapes.Count
If .Sheets(Arkusz).Shapes.Item(i).Type = msoPicture Then
.Sheets(Arkusz).Shapes.Item(i).PictureFormat.ColorType = msoPictureGrayscale
End If
Next i
Next Arkusz
End With
End Sub