ID tematu: 797
 |
problem z makrem kasującym zawartość komórek |
Autor |
Wiadomość |
ZACZES [Usunięty]
|
Wysłany: 28-03-2007, 10:24 problem z makrem kasującym zawartość komórek
|
|
|
Witam!
mam takie makro:
Cytat: | Sub kasuj()
' czyszczenie zakresów
Range("o7:q29").ClearContents
ActiveSheet.Shapes.SelectAll
Selection.Delete
Range("d7:m29").ClearContents
Range("a7:c7").ClearContents
Range("a7:a29").ClearContents
' obramowanie zaznaczenia
Range("Q7:Q29").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' ustawianie kursora na w pierwszym wierszu tabeli
Range("a7").Select
End Sub |
Niestety wyskakuje mi błąd "Run Time error 7 - out of memory" - nie wiem dlaczego jest to out of memory, na początku makro działało dobrze, a później zonk
ma ktoś pojęcie o co może chodzić
Może dałoby się uprościć nieco sam kod...
pozdrawiam |
|
 | ID posta:
4149
|
|
|
 |
|
|
|
cerber1
ExcelSpec

Pomógł: 36 razy Posty: 143
|
Wysłany: 28-03-2007, 22:22
|
|
|
Spróbój tak:
Kod: |
Sub kasuj()
' czyszczenie zakresów
Range("o7:q29,d7:m29,a7:c7,a8:a29").Select
Selection.ClearContents
' obramowanie zaznaczenia
Range("F4:g9").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' ustawianie kursora na w pierwszym wierszu tabeli
Range("a7").Select
End Sub
|
Zamiast Selection.ClearContents może być Selection.Clear w zależności od potrzeb. |
|
 | ID posta:
4171
|
|
|
 |
|
|
Tajan

Pomógł: 5252 razy Posty: 11450
|
Wysłany: 28-03-2007, 23:17
|
|
|
Skoro już upraszczamy, to proponuję taki kod:
Kod: |
Sub kasuj()
With ActiveSheet.Shapes
Do While .Count > 0
.Item(.Count).Delete
Loop
End With
' czyszczenie zakresów
Range("o7:q29,d7:m29,a7:c7,a8:a29").ClearContents
' obramowanie zaznaczenia
With Range("F4:g9")
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
End With
' ustawianie kursora na w pierwszym wierszu tabeli
Range("a7").Select
End Sub
|
Używanie instrukcji Select i obiektu Selection, jest w takich przypadkach w 99% zupełnie zbędne, niepotrzebnie komplikując kod i spowalniając jego działanie. |
|
 | ID posta:
4176
|
|
|
 |
|
|
ZACZES [Usunięty]
|
Wysłany: 31-03-2007, 11:39
|
|
|
wychodzą jakieś dziwne rzeczy. Załączam plik, jakbyście mogli rzucić okiem...
Acha, zapomniałem dodać makro do arkusza, u mnie jest w arkuszu makr osobistych.
RAPORT-SALES KLIF.zip
|
Pobierz Plik ściągnięto 389 raz(y) 10.13 KB |
|
|
 | ID posta:
4302
|
|
|
 |
|
|
Tajan

Pomógł: 5252 razy Posty: 11450
|
Wysłany: 01-04-2007, 00:39
|
|
|
Jeżeli chodzi o tabelę na arkuszu 1, to proponuję tak:
Kod: | Sub kasuj()
Dim sh As Shape
' czyszczenie zakresów
Range("o7:q29,d7:m29,a7:c7,a8:a29").ClearContents
' obramowanie zaznaczenia
With Range("q7:q29")
For Each sh In ActiveSheet.Shapes
If Union(sh.TopLeftCell, .Cells).Address = _
.Address Then
sh.Delete
End If
Next
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
' ustawianie kursora na w pierwszym wierszu tabeli
Range("a7").Select
End Sub
|
|
|
 | ID posta:
4319
|
|
|
 |
|
|
ZACZES [Usunięty]
|
Wysłany: 01-04-2007, 18:28
|
|
|
dzięki Tajan. Teraz wszystko gra
pozdrawiam |
|
 | ID posta:
4330
|
|
|
 |
|
|
|
Nie możesz pisać nowych tematów Nie możesz odpowiadać w tematach Nie możesz zmieniać swoich postów Nie możesz usuwać swoich postów Nie możesz głosować w ankietach Nie możesz załączać plików na tym forum Możesz ściągać załączniki na tym forum
|
Dodaj temat do Ulubionych Wersja do druku
|
|
Strona używa plików cookies.
Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe
|