Фон
Я использую Excel 2007 в Windows 10. Позвольте мне кое-что сказать о сценарии заранее: я запускаю сценарий из рабочего листа под названием "расчет", затрагивающий некоторые ячейки на листе "printlayout". Он запускается каждый раз, когда меняются некоторые ячейки в «расчете». «Вычисление» находится в обычном представлении , в то время как «Printlayout» находится в представлении макета . измененные ячейки сбрасываются каждый раз при запуске скрипта, затем заполняются некоторыми строками, затем применяется текстовый формат, например, некоторые слова становятся жирным шрифтом (и задается также глобальный стиль шрифта, границы, перенос текста).
Проблема
1.1) Если вы откроете рабочую книгу, и активным листом будет «расчет», сценарий будет запущен за считанные миллисекунды.
1.2) Если вы изменили лист и go хотя бы один раз, чтобы увидеть «printlayout», а затем снова запустили сценарий, он работает ДЕЙСТВИТЕЛЬНО медленно, для завершения секунд (независимо от того, на каком листе вы находитесь: вы можете снова вернуться к «расчету», но это не повлияет на результат) .
1.3.1) Если вы закроете файл, откройте его снова, и активным листом будет «printlayout», затем сценарий снова запускается в миллисекундах (go до точки 1.1)
1.3.2) Если вместо этого открыть файл и активным листом будет "printlayout", то go до точки 1.2
1.4) проблема Доу не отображается, если я изменил представление «printlayout» на нормальное, но я не нашел способа сделать это в скрипте ...
Пример кода
Это событие onchange (в коде таблицы "вычисления"):
Private Sub Worksheet_Change(ByVal Target As Range)
' attivazione macro "Grassettare" quando certe celle vengono cambiate
If Sheets("calculation").Range("activatemacro").Value = "yes" Then
Dim KeyCells As Range
Set KeyCells = Sheets("calculation").Range("A2:E80")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call Grassettare
End If
End If
End Sub
Это структура кода, который я использую:
Sub Grassettare()
' try to speed up the process...
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlManual
End With
Sheets("printlayout").DisplayPageBreaks = False
' code, code, code... some loops,
' not a lot of cells to be looped by the way (about 50)
' end of my code...
Sheets("printlayout").DisplayPageBreaks = True
With Application
.Calculation = xlAutomatic
.DisplayStatusBar = True
.ScreenUpdating = True
End With
End Sub
Более глубокий анализ
Для тех, кто спрашивал о коде, который я пропустил в предыдущем разделе пример кода , вот оно! Имейте в виду: это немного долго. Для лучшего понимания я попытаюсь объяснить, что он делает: на листе « расчет »: диапазон ячеек Z1: AF50 содержит заголовок, представляющий свойство (значения от 1 до 7 ); при этом существуют столбцы, в которых хранятся индексы строк, соответствующие именам в столбце «А», которые имеют указанное выше свойство в столбце «C». Есть еще один столбец, «B», который может содержать строку «*». Я создаю строку, содержащую каждое имя «A», разделенное «-» (например, «name1 - name5 - name6»), которые имеют одинаковое свойство в столбце «C». Я поместил эти строки в последующие ячейки на листе " printlayout ". После этого я выделяю имена, которые имеют свойство «*» в столбце «B» (например, если name5 имеет свойство «*», тогда я получаю «name1 - name5 - name6»).
В конце скрипта вы видите, что только что обновленные ячейки также скопированы ниже. Я думаю, что я могу скопировать весь диапазон, чтобы уменьшить накладные расходы, вместо того, чтобы копировать каждую ячейку на каждом шаге. Но это не проблема.
Посмотрите:
' definizioni
Dim valoriColonna As Range
Dim valoriRiga As Range
Dim colonna As Integer
Dim col As Integer
Dim rig As Integer
Dim length As Integer
Dim temp As String
Dim toBold As String
Dim AtoBold() As String
Dim lista As String
Dim Alista() As String
Dim grassetto As String
Dim Agrassetto() As String
Dim da As Integer
Dim a As Integer
Dim keepformat(0 To 2) As Variant
Dim cellaFinituraLucida As Integer
Dim cellaFinituraSuede As Integer
' assegnazione
Set valoriColonna = Sheets("calculation").Range("Z1:AF1") ' sono le fascie
Set valoriRiga = Sheets("calculation").Range("Z2:AF" & Sheets("calculation").Range("AS3").Value) ' lista indici riga del colore secondo fascia
cellaFinituraLucida = 8 ' numero riga inizio finitura lucida nei LISTINI
cellaFinituraSuede = 18 ' numero riga inizio finitura lucida nei LISTINI
' assegnazione stile
keepformat(0) = "Calibri" ' Name = nome del font
keepformat(1) = False ' Bold = grassetto (o no)
keepformat(2) = True ' WrapText = testo a capo
cellaFinituraLucida = cellaFinituraLucida - 1
cellaFinituraSuede = cellaFinituraSuede - 1
For col = 1 To valoriColonna.Columns.Count
grassetto = ""
lista = ""
toBold = ""
length = 0
For rig = 1 To valoriRiga.Rows.Count
If IsNumeric(valoriRiga.Cells(rig, col).Value) Then
colonna = valoriRiga.Cells(rig, col).Value
If Sheets("calculation").Range("B" & (colonna + 1)).Value = "*" Then
toBold = toBold & "1" & ","
Else
toBold = toBold & "0" & ","
End If
temp = Sheets("calculation").Range("A" & (colonna + 1)).Value
length = length + Len(temp)
grassetto = grassetto & length & "," ' contiene lunghezze parole divise da virgola
lista = lista & temp & "," ' contiene parole divise da virgola
' Debug.Print "c." & colonna & " lista=" & temp & " grassetto=" & grassetto
End If
Next
' -----
Agrassetto = Split(grassetto, ",")
ReDim Preserve Agrassetto(UBound(Agrassetto) - 1) ' rimosso ultimo elemento
Alista = Split(lista, ",")
ReDim Preserve Alista(UBound(Alista) - 1) ' rimosso ultimo elemento
AtoBold = Split(toBold, ",")
ReDim Preserve AtoBold(UBound(AtoBold) - 1) ' rimosso ultimo elemento
' -----
' Debug.Print Join(AtoBold)
lista = Join(Alista, " - ")
' preparo le celle della finitura suede
With Sheets("printlayout").Range("A" & (cellaFinituraSuede + col))
.Clear
.Font.Name = keepformat(0)
.Font.Bold = keepformat(1)
.WrapText = keepformat(2)
End With
' preparo le celle della finitura lucida
With Sheets("printlayout").Range("A" & (cellaFinituraLucida + col))
.Clear
.Font.Name = keepformat(0)
.Font.Bold = keepformat(1)
.WrapText = keepformat(2)
.Borders.LineStyle = xlContinuous
.Value = lista
End With
' primo elemento
If AtoBold(0) = "1" Then
da = 1
a = Val(Agrassetto(0))
With Sheets("printlayout").Range("A" & (cellaFinituraLucida + col)).Characters(da, a).Font
.Bold = True
End With
Else
da = 1
a = Val(Agrassetto(0))
With Sheets("printlayout").Range("A" & (cellaFinituraLucida + col)).Characters(da, a).Font
.Bold = False
End With
End If
' successivi elementi
For rig = 1 To UBound(Agrassetto)
If AtoBold(rig) = "1" Then
da = Val(Agrassetto(rig - 1)) + 1 + 3 * rig ' origine (start)
a = Val(Agrassetto(rig)) - Val(Agrassetto(rig - 1)) ' lunghezza parola
With Sheets("printlayout").Range("A" & (cellaFinituraLucida + col)).Characters(da, a).Font
.Bold = True
End With
Else
da = Val(Agrassetto(rig - 1)) + 1 + 3 * rig
a = Val(Agrassetto(rig)) - Val(Agrassetto(rig - 1))
With Sheets("printlayout").Range("A" & (cellaFinituraLucida + col)).Characters(da, a).Font
.Bold = False
End With
End If
Next
' copio le celle della finitura lucida in quelle della suede
Sheets("printlayout").Range("A" & (cellaFinituraLucida + col)) _
.Copy (Sheets("printlayout").Range("A" & (cellaFinituraSuede + col)))
Next
Вопрос
Это известная ошибка? Это предотвратимо? как же так? Спасибо, дайте мне знать, если у кого-нибудь есть идеи!