Гость
Войти | Профиль | Очистить
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Только формулы в word / 12 сообщений из 12, страница 1 из 1
07.08.2015, 15:48
    #39025166
werovulv
werovulv
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
Здравствуйте уважаемые форумчане! Такой вот вопрос, имеется макрос, должен оставлять только формулы в ворде, а при работе он полностью все стирает, подскажите пожалуйста в чем ошибка:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
Sub NumberOfSheets()
  
 Dim oInlineShape As InlineShape
For Each oInlineShape In ActiveDocument.InlineShapes
 oInlineShape.Delete
Next
  
  
 Dim p As Paragraph, r As Range
For Each p In ActiveDocument.Paragraphs
  Set r = p.Range
  If Not r.Information(wdWithInTable) Then
    If r.InlineShapes.Count = 0 Then
      r.Delete
    End If
  End If
Next
 
 
 
    
    Do While ActiveDocument.Tables.Count <> 0
    ActiveDocument.Tables(1).Delete
Loop
 
 
 
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 16:10
    #39025196
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
образец документа будет?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 18:48
    #39025309
werovulv
werovulv
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
Вот к примеру:
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 19:02
    #39025314
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
Ок. Почему код
Код: vbnet
1.
2.
3.
For Each oInlineShape In ActiveDocument.InlineShapes
 oInlineShape.Delete
Next

не должен стирать формулы? В нем нет никаких условий
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 19:09
    #39025319
werovulv
werovulv
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
Shocker.ProОк. Почему код
Код: vbnet
1.
2.
3.
For Each oInlineShape In ActiveDocument.InlineShapes
 oInlineShape.Delete
Next

не должен стирать формулы? В нем нет никаких условий

Так этот кусок должен чистить от картинок
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 19:16
    #39025323
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
werovulvТак этот кусок должен чистить от картинокэтот кусок чистит от инлайн-шейпов, подо что попадает и ваша формула
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 19:31
    #39025329
werovulv
werovulv
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
Shocker.ProwerovulvТак этот кусок должен чистить от картинокэтот кусок чистит от инлайн-шейпов, подо что попадает и ваша формула
Хмм. А не подскажите какое необходимо условие, а то у меня что то идей на счет этого нет
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 19:47
    #39025336
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
Не знаю, можно попробовать для начала с типами поиграть
Код: vbnet
1.
2.
3.
4.
Dim oInlineShape As InlineShape
For Each oInlineShape In ActiveDocument.InlineShapes
 Debug.Print oInlineShape.Type
Next

Если этого будет недостаточно (есть другие внедренные объекты), потыкайтесь в другие свойства объекта, почитайте их описание
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 19:54
    #39025337
ПЕНСИОНЕРКА
ПЕНСИОНЕРКА
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
werovulv,


попробуйте на копии
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
Sub w150807()
'
Dim j1
Dim tbl As Table
j1 = Word.ActiveDocument.Tables.Count
Do While j1 > 0
Word.ActiveDocument.Tables(j1).Select
    Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
        NestedTables:=True
        j1 = j1 - 1
        Loop
       
''''''''''''''''''''''''

 
'замена букв
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        '.Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ''''''''замена цифр
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^#"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        '.Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
''замена знаков препинания
    With Selection.Find
        .Text = "[\/\.\,\!\?\=\-\_\ №]"
        .Replacement.Text = ""
        '.Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
''убирание лишних абзацов
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        '.Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 20:03
    #39025341
werovulv
werovulv
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
ПЕНСИОНЕРКА, Все равно к сожалению остается картинка. А вот с этим кодом можно сделать что то? Он у меня удаляет чисто формулы не трогая картинки, можно ль обратно как то сделать, чтоб удаление было?
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Dim t As Object, y As OLEFormat
For Each t In ActiveDocument.InlineShapes
  GoSub chk
Next
For Each t In ActiveDocument.Shapes
  GoSub chk
Next
Exit Sub
 
chk:
  Set y = t.OLEFormat
  If Not y Is Nothing Then
    If y.ClassType Like "*Equation*" Then
      t.Delete
    End If
  End If
Return
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 20:40
    #39025356
ПЕНСИОНЕРКА
ПЕНСИОНЕРКА
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
werovulv,

добавила в хвост
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
j1 = Word.ActiveDocument.Shapes.Count
Do While j1 > 0
Debug.Print "*"; j1;
Word.ActiveDocument.Shapes(j1).ConvertToInlineShape
j1 = j1 - 1
Loop
Dim j2
j1 = Word.ActiveDocument.InlineShapes.Count
Do While j1 > 0
j2 = Word.ActiveDocument.InlineShapes(j1).Type
If j2 = 1 Then
Debug.Print "=", Word.ActiveDocument.InlineShapes(j1).OLEFormat.ProgID
Else

Word.ActiveDocument.InlineShapes(j1).Delete
End If
j1 = j1 - 1
Loop
'
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.08.2015, 20:47
    #39025360
werovulv
werovulv
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Только формулы в word
ПЕНСИОНЕРКА, ого!) Отлично все работает! Спасибо Вам большое!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Только формулы в word / 12 сообщений из 12, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 147ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2155835]:
 0ms
get settings:
 10ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 39ms
get topic data:
 12ms
get forum data:
 2ms
get page messages:
 49ms
get tp. blocked users:
 2ms
others: 12ms
total:  147ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]