Compress Picture

[a_zheshko]

В MS Office 2010 есть опция сжатия рисунков. Подскажите как на VB или Java можно поработать с этим объектом, а то я нашел тока решения через рибон

CommandBars.FindControl(ID:=6382).E xecute

[Ципихович Эндрю]

не понял это CommandBars.FindControl(ID:=6382).E xecute
и есть решение через рибон? Если нет выложите его пжл

[a_zheshko]

Ципихович Эндрю,
Эту строчку кода я для примера написал, решение выложу завтра, у меня на работе остался код, который я писал в пятницу...

Там вначале на рибоне ищется нужный контрол, затем посылаются Sand Keys и вызывается Compress Picture.

Извиняюсь, что сразу не писал сюда правильное решение. Т.к. дома у меня Linux, а под Windows получается писать только на работе

Спасибо, завтра скину код

[Ципихович Эндрю]

извиняем подождём

[a_zheshko]

Эндрю, добрался я наконец до Windows

Вот мой муть, который набросал в пятницу :

=================================== ==================

Sub DefineFileSize_By_A_Zheshko()
Rem Определяем полный путь к доку
Dim myDocName As String, myDocPath As String, myFullPath As String
With ActiveDocument: myDocName = .Name: myDocPath = .Path: End With
myFullPath = myDocPath & Chr(47) & myDocName
Set FSys = CreateObject("Scripting.FileSystemObject"): Set file = FSys.getfile(myFullPath)

With file
result = CInt((.Size / 1024) / 1024) & " MB  " & "(" & .Size & " Байт)"
mes_rez = MsgBox("Имя файла: " & .Name & Chr(13) & Chr(13) _
    & "Полный путь к файлу: " _
        & myFullPath & Chr(13) & Chr(13) _
           & "Размер файла: " & result _
            & Chr(13) & Chr(13) & "Жать будем?", vbInformation + vbYesNo, "Welcom ))")
           
            Select Case mes_rez
            Case vbYes
            Call ReduseImageSizeByA_Zheshko(compr = True)
            Case vbNo: Exit Sub
            End Select
End With
End Sub



Sub ReduseImageSizeByA_Zheshko(compr As Boolean)
For k = 1 To ActiveDocument.InlineShapes.Count
ActiveDocument.InlineShapes(k).Select
With Selection
Rem на всякий пожарный приводим все picture к единому формату
    .Cut
    .PasteSpecial wdPasteBitmap
    Rem.Style = ActiveDocument.Styles("Рис")
    Call CompressPics(True)
End With
Next k
End Sub



Sub CompressPics(ok As Boolean)
With Application.CommandBars.FindControl(ID:=6382)
SendKeys "%A%W{Enter}"
    .Execute
End With
End Sub

=================================== ===========
Код надо немного подшаманить, а то он жмёт нормально, но в потоке видимо не сохраняет.

По одной картинке получалось....
Сейчас нету времени этим заниматься. Пишу приложение под Android

PS: мне нужен более гибкий механизм, чем FindControl и SendKeys. Как сделать сие? Всем спасибо