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