Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 62909 Skopiuj do schowka Rozszerzanie Wysokości Wiersza
Autor Wiadomość
markos97 
Exceloholic



Pomógł: 29 razy
Posty: 227
Wysłany: 18-10-2018, 13:04   Rozszerzanie Wysokości Wiersza

Hej!
Cały temat (nie zmieścił mi się w tytule): "Rozszerzanie Wysokości Wiersza Dopasowane Do Różnych Wysokości Komórek W Tym Wierszu"

Jeśli chcemy automatycznie rozszerzać kolumnę za pomocą procedury to tutaj nie ma problemu, bo możemy to robić na "sztywniaka"
Kod:
Columns.EntireColumn.AutoFit
lub dynamicznie:
Kod:
Columns.AutoFit
cały kod w załączniku w arkuszu "kolumna"
natomiast jeśli chcemy to samo zrobić w przypadku wiersza?
na "sztywno" nie ma problemu, ale dynamicznie?
walczyłem z tym około 8-miu dni, w międzyczasie natrafiłem na post, gdzie tamtejszy ekspert stwierdził odpowiadając na pytanie użytkownika "asliae" (pytanie w punkt 1), iż nie da się tego zrobić...
Cytat:
https://www.ozgrid.com/forum/forum/help-forums/excel-general/67920-adjust-row-height-automatically

Dave Hawley: "you cannot format 1 row to different heights"


Usiadałem nad tym i napisałem kod, który to jednak robi... - patrz arkusz "wiersz_dynamiczny" dla porównania w arkusz "wiersz_statyczny" jak to się rozszerza na sztywniaka...

Cały kod - rozszerzanie dynamiczne:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Cells.RowHeight = 15
If Target.Cells.Count > 1 Then Exit Sub
        With Selection.EntireRow
        .RowHeight = 409
        .AutoFit
        End With
       
       ActiveCell.Offset(1, 0).EntireRow.Insert
       ActiveCell.Offset(1, 0) = ActiveCell
       ActiveCell.Offset(1, 0) = ActiveCell.Offset(1, 0).Height
         
      Rows(Target.Row).RowHeight = Target.Offset(1, 0).Value
     
      Rows(ActiveCell.Offset(1, 0).Row).Delete
Application.ScreenUpdating = True
End Sub


Aby sprawdzić działanie kodów po prostu przechodzimy strzałką lub klikamy myszką kolejne komórki...

Opinie, w tym inne pomysły/kody na zrobienie tego - mile widziane :-)

adjust_row_height_to_different_hights_cells_in_this_row.xlsm
Pobierz Plik ściągnięto 18 raz(y) 22.86 KB

_________________
Nic nie jest szczególnie trudne do zrobienia, jeśli tylko rozłożyć to na etapy - Henry Ford
Całość jest sumą poszczególnych części - znane twierdzenie matematyczne
Chcesz być wielki zaczynaj od rzeczy maleńkich - Augustyn z Hippony
ID posta: 354773 Skopiuj do schowka
 
 
kulasart
[Usunięty]

Wysłany: 18-10-2018, 13:46   

Ciekawa koncepcja. Spróbowałbym jednak obliczanie odpowiedniej wysokości wiersza wykonać w oddzielnym, tymczasowym arkuszu. Takie rozwiązanie jest dużo bezpieczniejsze i co najważniejsze szansa na to, że nie będziemy mogli wstawić nowego wiersza (choćby z uwagi na istnienie tabeli przestawnej w arkuszu) jest niemal zerowa.
ID posta: 354782 Skopiuj do schowka
 
 
markos97 
Exceloholic



Pomógł: 29 razy
Posty: 227
Wysłany: 18-10-2018, 16:03   

dzięki za pierwszą opinię dla kulasart i chyba się do tego zastosuję, gdyż..., ale o tym w samej końcówce tego postu...

zaś w samym kodzie drobna zmiana - linijkę
Kod:
If Target.Cells.Count > 1 Then Exit Sub
zamieniamy na:
Kod:
If Target.CountLarge > 1 Then Exit Sub
gdyż w przypadku gdybyśmy zaznaczyli wszystkie komórki arkusza, to wywaliłoby błąd...

właśnie wplatam kod w większą całość, testuję i już napotkałem pierwszą przeszkodę..., mianowicie gdy nacisnąłem ctrl i strzałkę w dół, aby przeskoczyć gdzieś tam w dół arkusza - wyskoczył komunikat....
Cytat:
Run-time error 1004:
Application defined or object defined error
- z tego co widzę, kod długo mieli, bo jest w nim wstawianie tego pustego wiersza, to nie jest zbyt udane, i kod długo myśli, dlatego ten błąd..., he, he :-)

oczywiście gdyby zablokować skoroszyt hasłem, nie dając możliwości użytkownikowi wgląd w kod, należałoby chyba jeszcze najlepiej ukryć ten dodatkowy arkusz, albo (jeśli jest to możliwe) zablokować możliwość usunięcia takiego arkusza ze skoroszytu...

dołączam załącznik z poprawionym kodem i dodatkowym arkuszem pomocniczym - wedle sugestii kulasart

adjust_row_height_to_different_hights_cells_in_this_row_vesion_2.xlsm
Pobierz Plik ściągnięto 17 raz(y) 25.05 KB

_________________
Nic nie jest szczególnie trudne do zrobienia, jeśli tylko rozłożyć to na etapy - Henry Ford
Całość jest sumą poszczególnych części - znane twierdzenie matematyczne
Chcesz być wielki zaczynaj od rzeczy maleńkich - Augustyn z Hippony
ID posta: 354795 Skopiuj do schowka
 
 
markos97 
Exceloholic



Pomógł: 29 razy
Posty: 227
Wysłany: 30-10-2018, 12:23   

hej ponownie!
poprzednie rozwiązanie nie jest optymalne, ten fragment:
Kod:
.Range("a1") = ActiveCell
należy zamienić raczej na coś w rodzaju:
Kod:
ActiveCell.Copy (Worksheets("ArPom").Range("A1"))
-taki zapis, czyli wierna (?) kopia przenosi wszystkie właściwości komórki jak rodzaj czcionki, jej wielkość, pogrubienie, podkreślenie, itp., itd...., bez tego - w poprzednim rozwiązaniu - gdy w arkuszu pomocniczym wystarczyło, że była ustawiona inna czcionka i inna wielkość niż w aktywnym arkuszu, sprawiało, że rozszerzanie nie było precyzyjne...
Poza tym doprecyzowałem ten zapis:
Kod:
.RowHeight = 409.5
- przez przypadek odkryłem, że może ona być właśnie nieco większa niż podaje to excel, tj. 409..., podobnie (?) szerokość kolumny:
Kod:
.ColumnWidth = 255#
Na przyszłość wystarczy tylko kontrolować na bieżąco jaka jest maksymalna wysokość i szerokość komórki w wyższych wersjach excela...

Ok. tym razem dwa skoroszyty: w pierwszym rozwiązanie z pomocniczym arkuszem. Po otwarciu pliku - msgbox pod zdarzeniem (kod w thisworkbook), przestrzegający przed usunięciem arkusza pomocniczego. Jeśli użytkownik pomimo to będzie chciał usunąć ten arkusz to kolejne zdarzenie (ale ono działa dopiero od wersji 2013 włącznie?), które przed usunięciem arkusza pomocniczego wstawi pusty arkusz o tej samej nazwie (w komentarzach proponuję chyba lepsze rozwiązanie, tj. ukrycie tego arkusza...).

Drugi skoroszyt bez arkusza pomocniczego, wszystko odbywa się w tym samym arkuszu, na samym jego dole, zapisałem to tak jak zapisałem, ale z tego co widzę, to rozwiązanie jest troszkę wolniejsze...

Zapoznajcie się z wszystkim jeszcze raz - w każdym arkuszu coś tam pozmieniałem...
Myślę, że teraz jest raczej wszystko w porządku...

Dzięki za poświęcony czas, i krytyczne uwagi.

adjust_row_height_to_different_hights_cells_in_this_row_wiersz_pomoczniczy_w_tym_samym_arkuszu.xlsm
Pobierz Plik ściągnięto 19 raz(y) 26.27 KB

adjust_row_height_to_different_hights_cells_in_this_row_z_arkuszem_pomocniczym.xlsm
Pobierz Plik ściągnięto 17 raz(y) 31.68 KB

_________________
Nic nie jest szczególnie trudne do zrobienia, jeśli tylko rozłożyć to na etapy - Henry Ford
Całość jest sumą poszczególnych części - znane twierdzenie matematyczne
Chcesz być wielki zaczynaj od rzeczy maleńkich - Augustyn z Hippony
ID posta: 355408 Skopiuj do schowka
 
 
kulasart
[Usunięty]

Wysłany: 30-10-2018, 17:41   

Robisz sporo niepotrzebnych operacji.
Kod:
Application.ScreenUpdating = False
If Target.CountLarge > 1 Then Exit Sub

Najpierw sprawdzamy warunki wyjścia, a dopiero później wykonujemy jakiekolwiek zmiany.
Jeżeli ktoś zaznaczy więcej niż jedną komórkę zostawiasz go z wyłączonym odświeżaniem ekranu...
Kod:
Cells.RowHeight = 15

W jakim celu ustawiasz wysokość wszyskich wierszy?
Kod:
Cells(Rows.Count, 1).End(xlDown).EntireRow.ClearContents

Wybierasz ostatnią komórkę pierwszej kolumny (Rows.Count) i chcesz zejść jeszcze niżej? :shock:
Dodatkowo czyścisz cały wiersz przed i po zakończeniu wszystkich operacji. Dużo łatwiej jest go usunąć na samym końcu.

Spróbuj tak:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If LenB(Target.Value) = 0 Then Exit Sub
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
   
    Dim tmpCell As Range
    Set tmpCell = Cells(Rows.Count, Target.Column)
   
    Target.Copy tmpCell
   
    Dim newHeight As Double
    With tmpCell
        .RowHeight = 409.5
        .ColumnWidth = 255
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
        newHeight = .Height
        .EntireRow.Delete
    End With
   
    Target.RowHeight = newHeight   
   
     With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
ID posta: 355432 Skopiuj do schowka
 
 
Artik 



Pomógł: 2575 razy
Posty: 8487
Wysłany: 04-11-2018, 11:40   

kulasart napisał/a:
Jeżeli ktoś zaznaczy więcej niż jedną komórkę zostawiasz go z wyłączonym odświeżaniem ekranu...
Choć jestem zwolennikiem włączania tego co wcześniej tymczasowo wyłączyłem, to akurat właściwość ScreenUpdating jest jedną z tych, która samoczynnie powraca do wartości True po zakończeniu makra głównego.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 355628 Skopiuj do schowka
 
 
kulasart
[Usunięty]

Wysłany: 04-11-2018, 12:02   

Artik, serio? Tyle lat pracuję z VBA i do tej pory byłem przekonany że trzeba ją włączyć po wyłączeniu.
Jak widać jeszcze wiele rzeczy do odkrycia przede mną :) Dziękuję!
ID posta: 355630 Skopiuj do schowka
 
 
Artik 



Pomógł: 2575 razy
Posty: 8487
Wysłany: 04-11-2018, 14:50   

Serio, serio. :-)
Choć Bill mówi wyraźnie, by włączać
Cytat:
Remember to set the ScreenUpdating property back to True when your macro ends.
Zerknij jeszcze na ten wątek.

DisplayAlerts także ustawia się na True po zakończeniu procedury.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 355642 Skopiuj do schowka
 
 
markos97 
Exceloholic



Pomógł: 29 razy
Posty: 227
Wysłany: 06-11-2018, 13:55   

Dzięki za wszystkie uwagi.

Wysokość wszystkich* (no może nie wszystkich - patrz uwagi niżej) wierszy, jak i szerokość wszystkich kolumn musi być ustawiona, bo w przeciwnym razie będzie tak, jakby ktoś do połowy został z opuszczonymi spodniami po wyjściu z komórek niepustych, zatem nieco przerobiłem na:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    'If LenB(Target.Value) = 0 Then Exit Sub 'com
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
   
    'aby niepuste komórki przyjęły po wyjściu z nich takie właśnie rozmiary...
    'zakomentowałem lenb na samej górze... -
    Cells.RowHeight = 15 'add - albo: Rows.RowHeight = 15
    Cells.ColumnWidth = 3 'add - albo: Columns.ColumnWidth = 3
   'nie wiem czy  różnica tych 2-óch linijek w zapisie ma wpływ na szybkość kodu?

   If LenB(Target.Value) <> 0 Then 'add
    Dim tmpCell As Range
    Set tmpCell = Cells(Rows.Count, Target.Column)
   
    Target.Copy tmpCell
   
    Dim newHeight As Double
    With tmpCell
        .RowHeight = 409.5
        .ColumnWidth = 255
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
        newHeight = .Height
        .EntireRow.Delete
    End With
   
    Target.RowHeight = newHeight
   End If 'add
     With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

*w zasadzie nie chodzi tu o wszystkie wiersze, ale o używane komórki (to zdaje się jest used range?) - można by to więc zmienić na szukanie wierszy i kolumn niepustych i tylko dla nich ustawiać określoną wysokość i szerokość - jeśli przełożyłoby się to na szybsze działanie kodu - mnie na razie nie wychodzi, nie wiem jednak czy to ma sens, gdyż zauważyłem, że przeważnie piszący kody raczej zapisują to mniej więcej tak jak powyżej...

W Twoim kodzie podoba mi się ta nowa wysokość "as double", sprawdzasz na jakie rozmiary komórkę trzeba ustawić, usuwasz ten ostatni wiersz, w którym przed chwilą była ta wartość, a wartość przechodzi do pamięci excela(?)/komputera(?); ponadto szerokość ustawiana jest na szerokość komórki z ostatniego wiersza (mój pomysł, ale u Ciebie w makrze bez konieczności deklarowania tego w kodzie...).

Poczytałem też o LenB - tam piszą, że ta długość wyrażana jest w bitach i podaje minimum 2, czy nie wystarczyłoby jednak zwykłe poczciwe len?
_________________
Nic nie jest szczególnie trudne do zrobienia, jeśli tylko rozłożyć to na etapy - Henry Ford
Całość jest sumą poszczególnych części - znane twierdzenie matematyczne
Chcesz być wielki zaczynaj od rzeczy maleńkich - Augustyn z Hippony
ID posta: 355765 Skopiuj do schowka
 
 
kulasart
[Usunięty]

Wysłany: 06-11-2018, 14:09   

Jeżeli makro ma za zadanie dopasowywać wysokość/szerokość komórki do jej zawartości, to powinno robić tylko tyle. Kiedy dodajesz do niego kod odpowiedzialny za ustawienie stałej szerokości/wysokości pozostałych komórek (wierszy i kolumn) to w mojej ocenie robisz "za dużo".

Wyobraź sobię sytuację, w której jako użytkownik ustawiasz sobie zaznaczoną komórkę np. na D4. Makro automatycznie ustawia Ci jej wysokość i szerokość - SUPER.
Teraz postanawiasz manualnie rozszerzyć wysokość wierszy 5,6,7,8,9 i 10, tak żebyś widział to co potrzebujesz. Zaznaczasz komórkę C4 i.... i makro automatycznie przywraca Ci standardową wysokośc wszystkich wierszy.
Dokładnie to samo będzie się działo jeżeli będziesz zaznaczał puste komórki.
Za pierwszym razem pewnie machniesz ręką, ale za 5. czy 10. będziesz tak zirytowany, że wyłączysz całkowicie to makro.

LenB zwraca ilość zajmowanego miejsca w pamięci (wyrażona w bajtach), zaś Len zwraca ilość znaków.
Dlaczego używam LenB? Najzwyczajniej w świecie jest ona szybsza.
ID posta: 355768 Skopiuj do schowka
 
 
markos97 
Exceloholic



Pomógł: 29 razy
Posty: 227
Wysłany: 09-11-2018, 17:18   

to zwężanie nie wzięło się u mnie nagle...
ja to finalnie widzę nieco inaczej gdy "biega" o przeznaczenie kodu; u mnie jest tak, że kładę nacisk na oszczędność miejsca w arkuszu, i dlatego właśnie to zwężanie i procedura; co do zwężania kolumny, w ostatnim poście napisałem:
Cytat:
ponadto szerokość ustawiana jest na szerokość komórki z ostatniego wiersza (mój pomysł, ale u Ciebie w makrze bez konieczności deklarowania tego w kodzie...)
- ja będę to musiał u siebie w arkuszu jednak zadeklarować w kodzie, bo w pierwszym wierszu będę mieć nagłówki, i muszą one być widoczne, ale to już powiedzmy odrębna sprawa...

to już chyba ostatnia moje korekta w kodzie:
Kod:
Range("A1").SpecialCells(xlCellTypeConstants).RowHeight = 15
Range("A1").SpecialCells(xlCellTypeConstants).ColumnWidth = 3

i tutaj ukłony dla kuma: http://www.excelforum.pl/...t=37517&start=0
teraz powinno być szybciej... :-)

@kulasart ok. może różnimy się nieco w detalach, ale generalnie zrobiliśmy tutaj naprawdę kawał dobrej roboty
dzięki również dla Artik wszystkim należą się browarki :-)
:beer
_________________
Nic nie jest szczególnie trudne do zrobienia, jeśli tylko rozłożyć to na etapy - Henry Ford
Całość jest sumą poszczególnych części - znane twierdzenie matematyczne
Chcesz być wielki zaczynaj od rzeczy maleńkich - Augustyn z Hippony
ID posta: 355996 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
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

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

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