powered by simpleCommunicator - 2.0.58     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Слетают форматы ячеек при обновлении сводной таблицы
9 сообщений из 9, страница 1 из 1
Слетают форматы ячеек при обновлении сводной таблицы
    #37837254
M i x
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
При обновлении сводной таблицы слетают форматы ячеек - есть ли решение этой проблемы?
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37837410
Фотография Serge 007
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
M i x,

как форматы ставите?
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37837653
M i x
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Serge 007,
С помощью вот такого скрипта:


Код: 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.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
' Устанавливаем ориентацию и выравнивание
        
 ' Шапка
        For Each pvtField In .RowFields

        With pvtField.LabelRange
         '.DataLabelRange
           .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Шапка", 2)))
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Шапка", 2)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Шапка", 2)
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Шапка", 2)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Шапка", 2)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Шапка", 2)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Шапка", 2)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
        End With
        Next pvtField

 ' Боковик - строки
        i = 2
        ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        While Len(Trim(ОбластьСтрок)) > 0
          With .PivotFields(ОбластьСтрок).DataRange
            
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Строк", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Строк", i)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Строк", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Строк", i)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Строк", i)))
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Строк", i)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Строк", i)
            End If
           
           
          End With
          'MsgBox Str(i) + " " + ОбластьСтрок
          i = i + 1
          
          ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        Wend
 ' Область столбцов
        i = 2
        ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        While Len(Trim(ОбластьСтолбцов)) > 0
          With .PivotFields(ОбластьСтолбцов).DataRange
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Столбцов", i)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Столбцов", i) + 0
            End If
            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Столбцов", i)))
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Столбцов", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Столбцов", i)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Столбцов", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Столбцов", i)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
          End With
          i = i + 1
          ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        Wend
   ' Область данных
        i = 2
        ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
        While Len(Trim(ОбластьДанных)) > 0
          With .DataBodyRange
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Данных", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Данных", i)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j

            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Данных", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Данных", i)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Данных", i)))
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Данных", i)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Данных", i)
            End If
          End With
          i = i + 1
          ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
        Wend
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37837682
M i x
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот весь код процедуры:
Код: 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.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
Private Sub Создать_сводную_таблицу(ЛистНастроек As String, oWbkData As Workbook)
 Dim sh, nsh As Worksheet
 Dim ra As Range
 Dim pt As PivotTable, pc As PivotCache

 Dim ИмяСводной As String, ДиапазонДанных As String, ИмяЛистаДанных As String, Заголовок As String, _
     ОбластьСтрок As String, ОбластьСтрокПред As String, ОбластьСтолбцов As String, ОбластьДанных As String
 Dim i As Integer, j As Integer, k As Integer, n As Integer
 Dim СортировкапоБЕ As String, СортировкапоПредприятию  As String
    
    Set nsh = ThisWorkbook.Worksheets(ЛистНастроек)

    ИмяСводной = ПолучитьЗначение(nsh, "Имя сводной", 2)
    ИмяЛистаДанных = ПолучитьЗначение(nsh, "Имя листа данных", 2)
    ДиапазонДанных = ПолучитьЗначение(nsh, "Диапазон данных", 2)

    
    With oWbkData.Sheets(ИмяЛистаДанных)
      'Set ra =.Range(ДиапазонДанных)
       Set ra = .UsedRange
    End With
'oWbkData.Sheets(ИмяСводной).Delete
    
    
    Set pc = oWbkData.PivotCaches.Add(xlDatabase, ra.Address(True, True, xlR1C1))
    Set sh = oWbkData.Worksheets.Add(before:=oWbkData.Worksheets(1))
    sh.Name = ИмяСводной
    With sh.Cells
      If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Лист", 2)) > 0 Then
        Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Лист", 2)))
          Case "по левому краю"
            j = xlLeft
          Case "по центру"
            j = xlCenter
          Case "по правому краю"
            j = xlRight
          Case Else: j = xlLeft
        End Select
        .HorizontalAlignment = j
      End If
      If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Лист", 2)) > 0 Then
        Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Лист", 2)))
          Case "по верхнему краю"
            j = xlTop
          Case "по центру"
            j = xlCenter
          Case "по нижнему краю"
            j = xlBottom
          Case Else: j = xlTop
        End Select
        .VerticalAlignment = j
      End If
      .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Лист", 2)))
    End With
    With sh.PageSetup
        .Zoom = False
        If Trim(UCase("Альбомная")) = Trim(UCase(ПолучитьЗначение(nsh, "Ориентация Листа", 2))) Then
          .Orientation = xlLandscape
        Else
          .Orientation = xlPortrait
        End If
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    If IsNumeric(ПолучитьЗначение(nsh, "Zoom", 2)) Then
      oWbkData.Activate
      sh.Select
      ActiveWindow.Zoom = ПолучитьЗначение(nsh, "Zoom", 2)
    End If
    ActiveWindow.View = xlPageBreakPreview
    Set pt = sh.PivotTables.Add(pc, sh.Range("A3"), ИмяСводной, True, xlPivotTableVersion10)
'=======================================================================
    With pt
' Дополнительные настройки сводных таблиц:
      .HasAutoFormat = UCase(Trim(ПолучитьЗначение(nsh, "Автоматически изменять ширину столбцов при обновлении", 2))) = "ДА"
      .ShowDrillIndicators = UCase(Trim(ПолучитьЗначение(nsh, "Показывать кнопки развертывания и свертывания", 2))) = "ДА"
      .SaveData = UCase(Trim(ПолучитьЗначение(nsh, "Сохранить исходные данные вместе с файлом", 2))) = "ДА"
      With .PivotCache
        .RefreshOnFileOpen = UCase(Trim(ПолучитьЗначение(nsh, "Обновить при открытии файла", 2))) = "ДА"
        .MissingItemsLimit = xlMissingItemsNone 'Число элементов, сохраняемых для каждого поля
      End With
      '.PreserveFormatting = UCase(Trim(ПолучитьЗначение(nsh, "Сохранить форматирование ячеек при обновлении", 2))) = "ДА"
      .PreserveFormatting = True
      
      If UCase(Trim(ПолучитьЗначение(nsh, "Сортировка списка полей", 2))) = UCase(Trim("от А до Я")) Or _
         UCase(Trim(ПолучитьЗначение(nsh, "Сортировка списка полей", 2))) = UCase(Trim("ДА")) _
      Then
        .FieldListSortAscending = True
      Else 'как в источнике данных
        .FieldListSortAscending = False
      End If
      .SortUsingCustomLists = UCase(Trim(ПолучитьЗначение(nsh, "Использовать списки при сортировке", 2))) = "ДА"

 '=======================================================================
       
        
        .NullString = "" 'В случае если пустая ячейка
        i = 2
        ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        While Len(Trim(ОбластьСтрок)) > 0
          With .PivotFields(ОбластьСтрок)
            .Orientation = xlRowField
            .Subtotals = _
              Array(False, False, False, False, False, False, False, False, False, False, False, False)
          End With
          i = i + 1
          ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        Wend
        i = 2
        ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        While Len(Trim(ОбластьСтолбцов)) > 0
          With .PivotFields(ОбластьСтолбцов)
            .Orientation = xlColumnField
            .Subtotals = _
              Array(False, False, False, False, False, False, False, False, False, False, False, False)
          End With
          i = i + 1
          ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        Wend
        i = 2
        ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
        While Len(Trim(ОбластьДанных)) > 0
          With .PivotFields(ОбластьДанных)
            .Orientation = xlDataField
          End With
          i = i + 1
          ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
        Wend
       
       '.RowRange.WrapText = True
       '.ColumnRange.Orientation = 90
       '.DataLabelRange.WrapText = False
       '.ColumnRange.ShrinkToFit = True
       '.ColumnRange.AutoFit
       'Устанавливаем красивости:
'======================================================================
' Устанавливаем ориентацию и выравнивание
        
 ' Шапка
        For Each pvtField In .RowFields

        With pvtField.LabelRange
         '.DataLabelRange
           .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Шапка", 2)))
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Шапка", 2)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Шапка", 2)
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Шапка", 2)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Шапка", 2)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Шапка", 2)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Шапка", 2)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
        End With
        Next pvtField

 ' Боковик - строки
        i = 2
        ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        While Len(Trim(ОбластьСтрок)) > 0
          With .PivotFields(ОбластьСтрок).DataRange
            
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Строк", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Строк", i)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Строк", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Строк", i)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Строк", i)))
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Строк", i)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Строк", i)
            End If
           
           
          End With
          'MsgBox Str(i) + " " + ОбластьСтрок
          i = i + 1
          
          ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        Wend
 ' Область столбцов
        i = 2
        ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        While Len(Trim(ОбластьСтолбцов)) > 0
          With .PivotFields(ОбластьСтолбцов).DataRange
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Столбцов", i)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Столбцов", i) + 0
            End If
            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Столбцов", i)))
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Столбцов", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Столбцов", i)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j
            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Столбцов", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Столбцов", i)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
          End With
          i = i + 1
          ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        Wend
   ' Область данных
        i = 2
        ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
        While Len(Trim(ОбластьДанных)) > 0
          With .DataBodyRange
            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Данных", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Данных", i)))
                Case "по левому краю"
                  j = xlLeft
                Case "по центру"
                  j = xlCenter
                Case "по правому краю"
                  j = xlRight
                Case Else: j = xlLeft
              End Select
              .HorizontalAlignment = j

            End If
            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Данных", i)) > 0 Then
              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Данных", i)))
                Case "по верхнему краю"
                  j = xlTop
                Case "по центру"
                  j = xlCenter
                Case "по нижнему краю"
                  j = xlBottom
                Case Else: j = xlTop
              End Select
              .VerticalAlignment = j
            End If
            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Данных", i)))
            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Данных", i)) Then
              .Orientation = ПолучитьЗначение(nsh, "Ориентация Данных", i)
            End If
          End With
          i = i + 1
          ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
        Wend
        
        
        
        
'======================================================================
' Устанавливаем размеры столбцов и строк (авто, ручные)

 ' Боковик - строки
        i = 2
        ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        ОбластьСтрокПред = ОбластьСтрок
        While Len(Trim(ОбластьСтрок)) > 0
          With .PivotFields(ОбластьСтрок).DataRange
            If Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Авто ширина Строк", i))) Then
              .Columns.EntireColumn.AutoFit
            Else
              If IsNumeric(ПолучитьЗначение(nsh, "Ширина Строк", i)) Then
                .Columns.EntireColumn.ColumnWidth = ПолучитьЗначение(nsh, "Ширина Строк", i) + 0
              End If
            End If
            If Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Авто высота Строк", i))) Then
              .Rows.EntireRow.AutoFit
            Else
              If IsNumeric(ПолучитьЗначение(nsh, "Высота Строк", i)) Then
                .Rows.EntireRow.RowHeight = ПолучитьЗначение(nsh, "Высота Строк", i) + 0
              End If
            End If
          End With
          With .PivotFields(ОбластьСтрок)
            ' Сортировка
            If Trim(UCase("от А до Я")) = Trim(UCase(ПолучитьЗначение(nsh, "Сортировка Строк", i))) Then
              .AutoSort xlAscending, ОбластьСтрок
            Else
              If Trim(UCase("от Я до А")) = Trim(UCase(ПолучитьЗначение(nsh, "Сортировка Строк", i))) Then
                .AutoSort xlDescending, ОбластьСтрок
              End If
            End If
          End With
          'MsgBox Str(i) + " " + ОбластьСтрок
          i = i + 1
          ОбластьСтрокПред = ОбластьСтрок
          ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
        Wend
 ' Область столбцов
        i = 2
        ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        While Len(Trim(ОбластьСтолбцов)) > 0
          With .PivotFields(ОбластьСтолбцов)
            ' Сортировка
            If Trim(UCase("от А до Я")) = Trim(UCase(ПолучитьЗначение(nsh, "Сортировка Столбцов", i))) Then
              .AutoSort xlAscending, ОбластьСтолбцов
            Else
              If Trim(UCase("от Я до А")) = Trim(UCase(ПолучитьЗначение(nsh, "Сортировка Столбцов", i))) Then
                .AutoSort xlDescending, ОбластьСтолбцов
              Else
                If Trim(UCase("по БЕ")) = Trim(UCase(ПолучитьЗначение(nsh, "Сортировка Столбцов", i))) Then
                  j = 2
                  СортировкапоБЕ = ПолучитьЗначение(nsh, "Сортировка по БЕ", j)
                  n = 1
                  While Len(Trim(СортировкапоБЕ)) > 0
                    For k = 1 To .PivotItems.Count
                      If Trim(UCase(.PivotItems(k).Name)) = Trim(UCase(СортировкапоБЕ)) Then
                        .PivotItems(k).Position = n
                        n = n + 1
                        Exit For
                      End If
                    Next k
                    j = j + 1
                    СортировкапоБЕ = ПолучитьЗначение(nsh, "Сортировка по БЕ", j)
                  Wend
                Else
                  If Trim(UCase("по Предприятию")) = Trim(UCase(ПолучитьЗначение(nsh, "Сортировка Столбцов", i))) Then
                    j = 2
                    СортировкапоПредприятию = ПолучитьЗначение(nsh, "Сортировка по Предприятию", j)
                    n = 1
                    While Len(Trim(СортировкапоПредприятию)) > 0
                      For k = 1 To .PivotItems.Count
                        If Trim(UCase(.PivotItems(k).Name)) = Trim(UCase(СортировкапоПредприятию)) Then
                          .PivotItems(k).Position = n
                          n = n + 1
                          Exit For
                        End If
                      Next k
                      j = j + 1
                      СортировкапоПредприятию = ПолучитьЗначение(nsh, "Сортировка по Предприятию", j)
                    Wend
                  End If
                End If
              End If
            End If
          End With
          With .PivotFields(ОбластьСтолбцов).DataRange
            If Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Авто ширина Столбцов", i))) Then
             .Columns.EntireColumn.AutoFit
            Else
             If IsNumeric(ПолучитьЗначение(nsh, "Ширина Столбцов", i)) Then
               .Columns.EntireColumn.ColumnWidth = ПолучитьЗначение(nsh, "Ширина Столбцов", i)
             End If
            End If
            If Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Авто высота Столбцов", i))) Then
              .Rows.EntireRow.AutoFit
            Else
              If IsNumeric(ПолучитьЗначение(nsh, "Высота Столбцов", i)) Then
                .Rows.EntireRow.RowHeight = ПолучитьЗначение(nsh, "Высота Столбцов", i) + 0
              End If
            End If
          End With
          
          i = i + 1
          ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
        Wend
        ' Если нет столбцов/данных - скроем
        If i = 2 Then
            .DataBodyRange.EntireColumn.Hidden = True
            'Ставим правильно текст Приложение
            j = .DataBodyRange.Column - 1
            With sh.Cells(1, j)
              .Value = ПолучитьЗначение(nsh, "Приложение", 2)
              .HorizontalAlignment = xlRight
              .VerticalAlignment = xlCenter
              .Font.ColorIndex = xlAutomatic
              .Font.Bold = False
              .Font.Size = 12
              .WrapText = False
            End With
            'Устанавливаем правую границу
            If Len(Trim(ОбластьСтрокПред)) > 0 Then
              If Not (.PivotFields(ОбластьСтрокПред).DataRange Is Nothing) Then
                With .PivotFields(ОбластьСтрокПред).DataRange.Borders(xlEdgeRight)
                 .LineStyle = xlContinuous
                 .Weight = xlThin
                 .ColorIndex = xlAutomatic
                End With
              End If
            End If
         End If
 ' Шапка
        For Each pvtField In .RowFields
        With pvtField.LabelRange
            If Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Авто высота Шапка", 2))) Then
              .Rows.EntireRow.AutoFit
              Exit For
            Else
              If IsNumeric(ПолучитьЗначение(nsh, "Высота Шапка", 2)) Then
                .Rows.EntireRow.RowHeight = ПолучитьЗначение(nsh, "Высота Шапка", 2) + 0
              End If
            End If
            
        End With
      Next pvtField
      
''=======================================================================
'' повторно устанавливаем переносы строк и выравнивание:
' ' Боковик - строки
'        i = 2
'        ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
'        While Len(Trim(ОбластьСтрок)) > 0
'          With .PivotFields(ОбластьСтрок).DataRange
'
'            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Строк", i)) > 0 Then
'              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Строк", i)))
'                Case "по левому краю"
'                  j = xlLeft
'                Case "по центру"
'                  j = xlCenter
'                Case "по правому краю"
'                  j = xlRight
'                Case Else: j = xlLeft
'              End Select
'              .HorizontalAlignment = j
'            End If
'            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Строк", i)) > 0 Then
'              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Строк", i)))
'                Case "по верхнему краю"
'                  j = xlTop
'                Case "по центру"
'                  j = xlCenter
'                Case "по нижнему краю"
'                  j = xlBottom
'                Case Else: j = xlTop
'              End Select
'              .VerticalAlignment = j
'            End If
'            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Строк", i)))
'            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Строк", i)) Then
'              .Orientation = ПолучитьЗначение(nsh, "Ориентация Строк", i)
'            End If
'
'
'          End With
'          'MsgBox Str(i) + " " + ОбластьСтрок
'          i = i + 1
'
'          ОбластьСтрок = ПолучитьЗначение(nsh, "Область Строк", i)
'        Wend
' ' Область столбцов
'        i = 2
'        ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
'        While Len(Trim(ОбластьСтолбцов)) > 0
'          With .PivotFields(ОбластьСтолбцов).DataRange
'            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Столбцов", i)) Then
'              .Orientation = ПолучитьЗначение(nsh, "Ориентация Столбцов", i) + 0
'            End If
'            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Столбцов", i)))
'            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Столбцов", i)) > 0 Then
'              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Столбцов", i)))
'                Case "по левому краю"
'                  j = xlLeft
'                Case "по центру"
'                  j = xlCenter
'                Case "по правому краю"
'                  j = xlRight
'                Case Else: j = xlLeft
'              End Select
'              .HorizontalAlignment = j
'            End If
'            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Столбцов", i)) > 0 Then
'              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Столбцов", i)))
'                Case "по верхнему краю"
'                  j = xlTop
'                Case "по центру"
'                  j = xlCenter
'                Case "по нижнему краю"
'                  j = xlBottom
'                Case Else: j = xlTop
'              End Select
'              .VerticalAlignment = j
'            End If
'          End With
'          i = i + 1
'          ОбластьСтолбцов = ПолучитьЗначение(nsh, "Область Столбцов", i)
'        Wend
'   ' Область данных
'        i = 2
'        ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
'        While Len(Trim(ОбластьДанных)) > 0
'          With .DataBodyRange
'            If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Данных", i)) > 0 Then
'              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Данных", i)))
'                Case "по левому краю"
'                  j = xlLeft
'                Case "по центру"
'                  j = xlCenter
'                Case "по правому краю"
'                  j = xlRight
'                Case Else: j = xlLeft
'              End Select
'              .HorizontalAlignment = j
'
'            End If
'            If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Данных", i)) > 0 Then
'              Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Данных", i)))
'                Case "по верхнему краю"
'                  j = xlTop
'                Case "по центру"
'                  j = xlCenter
'                Case "по нижнему краю"
'                  j = xlBottom
'                Case Else: j = xlTop
'              End Select
'              .VerticalAlignment = j
'            End If
'            .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Данных", i)))
'            If IsNumeric(ПолучитьЗначение(nsh, "Ориентация Данных", i)) Then
'              .Orientation = ПолучитьЗначение(nsh, "Ориентация Данных", i)
'            End If
'          End With
'          i = i + 1
'          ОбластьДанных = ПолучитьЗначение(nsh, "Область Данных", i)
'        Wend
'
'      .PreserveFormatting = UCase(Trim(ПолучитьЗначение(nsh, "Сохранить форматирование ячеек при обновлении", 2))) = "ДА"
'
'    End With
'=======================================================================
' Настройки после формирования сводной таблицы для всего листа
    If UCase(Trim(ПолучитьЗначение(nsh, "Применять настройки Лист Пост", 2))) = "ДА" Then
    With sh.Cells
      If Len(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Лист Пост", 2)) > 0 Then
        Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по горизонтали Лист Пост", 2)))
          Case "по левому краю"
            j = xlLeft
          Case "по центру"
            j = xlCenter
          Case "по правому краю"
            j = xlRight
          Case Else: j = xlLeft
        End Select
        .HorizontalAlignment = j
      End If
      If Len(ПолучитьЗначение(nsh, "Выравнивание по вертикали Лист Пост", 2)) > 0 Then
        Select Case LCase(Trim(ПолучитьЗначение(nsh, "Выравнивание по вертикали Лист Пост", 2)))
          Case "по верхнему краю"
            j = xlTop
          Case "по центру"
            j = xlCenter
          Case "по нижнему краю"
            j = xlBottom
          Case Else: j = xlTop
        End Select
        .VerticalAlignment = j
      End If
      .WrapText = Trim(UCase("да")) = Trim(UCase(ПолучитьЗначение(nsh, "Переносить текст Лист Пост", 2)))
      '.Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
    End With
    End If
'=======================================================================
    'Заголовок
    With sh.Cells(1, 1)
      .Value = ПолучитьЗначение(nsh, "Заголовок", 2)
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlCenter
      .Font.ColorIndex = xlAutomatic
      .Font.Bold = True
      .Font.Size = 16
      .WrapText = False
    End With
    'Текст Приложение
    With sh.UsedRange
      i = .Column + .Columns.Count - 1
    End With
    With sh.Cells(1, i)
      .Value = ПолучитьЗначение(nsh, "Приложение", 2)
      .HorizontalAlignment = xlRight
      .VerticalAlignment = xlCenter
      .Font.ColorIndex = xlAutomatic
      .Font.Bold = False
      .Font.Size = 12
      .WrapText = False
    End With

    'Убираем окошко сводных таблиц
    sh.Application.CommandBars("PivotTable").Visible = False

End Sub



Хотел отредактировать своё предыдущее сообщение, не получилось.
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37837976
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
M i xПри обновлении сводной таблицы слетают форматы ячеек - есть ли решение этой проблемы?стоп стоп стоп, вы игрались с галочками в параметрах сводной таблицы, а именно "автоматич. изменять ширину после одбовления" и "сохранять форматирование ячеек при обновлении"
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37838054
M i x
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
авторстоп стоп стоп, вы игрались с галочками в параметрах сводной таблицы, а именно "автоматич. изменять ширину после одбовления" и "сохранять форматирование ячеек при обновлении"

Галочки выставляю в состояние выключено и включено соответственно. У меня страничка с настройками (см. вложение).
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37842126
M i x
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Что даже идей никаких нет?
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37843558
Денис Б.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
The new AutoFormat style is applied to the query table when the table is refreshed. The AutoFormat is reset to None whenever PreserveFormatting is set to False. As a result, any AutoFormat that’s set before PreserveFormatting is set to False and before the query table is refreshed doesn’t take effect, and the resulting query table has no formatting applied to it.
...
Рейтинг: 0 / 0
Слетают форматы ячеек при обновлении сводной таблицы
    #37843619
M i x
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Денис Б.The new AutoFormat style is applied to the query table when the table is refreshed. The AutoFormat is reset to None whenever PreserveFormatting is set to False. As a result, any AutoFormat that’s set before PreserveFormatting is set to False and before the query table is refreshed doesn’t take effect, and the resulting query table has no formatting applied to it.
Спасибо, а откуда эта ссылочка можно поинтересоваться?
...
Рейтинг: 0 / 0
9 сообщений из 9, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Слетают форматы ячеек при обновлении сводной таблицы
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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