Mam pewien problem troch� z i innej beczki - ale ca�y czas dotycz�cy
zaproponowanego przez Ciebie rozwi�zania. Sprawa tyczy si� drukowania
formularza z u�yt� instrukcj�. S�owo "TUTAJ" w kom�rce arkusza jest tego
samego koloru jak t�o - szare - by by�o niewidoczne. Tak te� jest -
jednak do czasu druku - s�owo to drukuje si� na czarno. Tak samo jest w
w podgl�dzie wydruku. Czy mog� by� temu winne ustawienia drukarki ?
Wejdz w podglad wydruku, tam daj ustawienia, a na zakladce "Arkusz" sprawdz,
czy nie masz tryb czarno-bialy. Generalnie, zeby wydrukowalo sie szare pole
z niewidocznym haslem musisz tez odznaczyc jakosc robocza...
Pozdrawiam
Michal
--
Bamek
ba...@bam.pl
Tryb nie jest czarno bia�y, tryb druku normalny - t�o jest drukowane na
szaro (wi�c poprawnie) , a litery s� czarne - mimo, �e na arkuszu w
excelu zlewaj� si� z t�em ??:(
Zalozmy ze mam "wiersz A"
Ponizej jest "wiersz B" (z ukrytym wyrazem TUTAJ) i makrem uruchamianym
poprzez przycisk polecenia CommandButton1 (w tym samym wierszu).
"Wiersz B" jak napisalem ma przypisane makro, ktore kopiuje ten wiersz do
wiersza ponizej. Kazde uruchomienie makra powoduje kolejne kopiowanie, i tak
np. po 2 krotnym uzyciu makra poprzez Command Button - mamy:
wiersz A - (wiersz 1
wiersza B (wiersz 2 )
kopia wiersza B (wiersz 4)
kopie wiersza B (wiersz 5).
I teraz moje pytanie, jak moglbym po takich roszadach - korzystajac z
wczesniej opisanego sposobu z ukryciem wyrazu TUTAJ 1 itd - skopiowac np. do
wiersza 6 wiersz A i ponizej niego (wiersza 7) wiersz B, finalnie
wyglada�oby to nastepujaco:
wiersz A - (wiersz 1)
wiersza B (wiersz 2 )
kopia wiersza B (wiersz 4)
kopie wiersza B (wiersz 5)
wiersz A - (wiersz 6)
wiersza B (wiersz 7 )
Zalezy mi przy tym by w wierszu B (wiersza 7) - kopiowal sie takze nacisk
CommandButton1 (probowalem tego i w zaden sposob przy opisanej metodzie nie
umiem). Wazne jest takze by wiersz B (w wierszu 7) mial dalej uzytecznosc
kopiowania poprzez makro (tu do wiersza 8, 9 itd) uruchamianem omawianym
CommandButton1. Zdaje sobie sprawe - ze skorzystanie z tego samego makra w
tym momencie spowoduje skopiowanie wiersza B - ale tego z pierwsze tury,
tzn. stworzenie kolejnej kopii wiersza B - do wiersza 6.
Oczywiscie opisany tu liczba uzycia makra kopiujacego wiersz B moze byc
wieksze, np. 3, 4 razy itd. Oznaczenie wiersz 1, 2 itd- takze jest tu
umowne - w rzeczywistosci sa one w kolejnych, ale innych numerowo wierszach.
Prosze o pomoc.
Nie wiem, czy jestes na to gotowy, bo to dosc mocno zaawansowane
programowanie...
Ja nigdy nie mialem potrzeby robic takich rzeczy, takze tylko pare wskazowek
posylam:
Sprobuj nagrac sobie makro (z kopiowania przycisku) i zobaczyc, jaki kod
wygeneruje.
Powinno cos takiego:
Shapes("CommandButton1").Select
Selection.Copy
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -12#
Selection.ShapeRange.IncrementTop 39#
Ale to przepisuje tylko przycisk, a nie kopiuje przypisanego do niego
makra...
Makro kryje sie w w ktorym z modulow - w twoim przypadku bedzie to modul,
przypisany do arkusza.
Czyli bedzie to obiekt
set mojmodul = ThisWorkbook.VBProject.VBComponents("MojArkusz").CodeModule
teraz w tym module musisz dodac nowy kod - najprosciej bedzie wywolac jakas
gotowa procedure.
Tylko zeby to zrobic, musisz znac nazwe nowo utworzonego przycisku.
Zakladajac, ze bedzie to ostatni w kolekcji, mozna sprobowac cos takiego:
Set mojprzycisk = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
Teraz mozesz juz dodac kod do przycisku:
With mojmodul
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Public Sub " & mojprzycisk.Name & "_Click()"
LineNum = LineNum + 1
.InsertLines LineNum, " Call MOJAPROCEDURA"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
Oczywiscie musisz sparametryzowac operacje, dodac/zmienic opisy przyciskow,
zmienic lokalizacje itp, ale to juz niewielka robota...
Byc moze da sie to zrobic prosciej/latwiej, ale jak mowilem - nie mam
doswiadczenia...
Pozdrawiam
Michal
Niestety nie znam innych ustawien, ktore moga spowodowac takie zachowanie...
Sprobuj na zupelnie nowym arkuszu sprawdzic wydruk z tym samym kolorem liter
i tla, czy bedzie zachowywac sie tak samo... Jesli tak - sprobuj to na innej
drukarce...
Jesli wszedzie bedzie zachowywac sie tak samo, to znaczy, ze to jakies
ustawienie systemowe, ale wtedy musisz pytac kogos innego...
Jesli w jakiejs konfiguracji bedziesz mial rozny wynik, to znaczy, ze
odpowiedz kryje sie albo w ustawieniach arkusza albo w drukarce. Zawsze to
jakies zawezenie problemu :)
Pozdrawiam
Michal
Niekt�re sterowniki do drukarek maj� opcje "Drukuj ca�y tekst w kolorze czarnym"
.. w Opcjach zaawansowanych / Grafiki itp.
--
IDKrzych
"Jakkolwiek b�dzie - b�dzie inaczej, ani�eli sobie wyobra�amy
- poniewa� mi�dzy Dobrem a Z�em znajdujemy si� w �yciu i w �wiecie
wielowymiarowym,
w kt�rym dokumentnie pomieszane jest Przypadkowe z Nieuchronnym."
(S. Lem 1999)
Do While ActiveSheet.Cells(i, "A").Value <> "TU"
i = i + 1
Loop
Rows(i & ":" & i + 1).Select
Selection.Copy
Rows(i + 2).Select
Selection.Insert Shift:=xlDown
Jak m�g�bym zmieni� ten kod, by skopiowany obszar (np. wiersz A i
ponizej wiersz B, wg opisu jak powyzej) byďż˝ kopiowany zawsze ponizej
kopii wiersza B, ktory byl wczesniej powielany poprzez kopiowanie
zalozmy 3 razy. W kazdej z kopii wiersza B jest wyraz "TUTAJ". Obecna
instrukcja zatrzymuje sie na pierwszym od gory wierszu z wyrazem TUTAJ i
wstawia dokladnie ponizej niego zaznaczony obszar. Przy funkcjach w
excelu dla wybrania ostatniego wiersza wykorzystuje np. funkcje MAX, jak
zrobic to przy tym kodzie w VBA ?
No tak na logike, to chyba najprosciej sprawdzac od dolu...
i = 65535
Do While ActiveSheet.Cells(i, "A").Value <> "TU"
i = i - 1
Loop
Pozdrawiam
Michal
Dim i As Byte
Dim k As Byte
i = 1
Do While ActiveSheet.Cells(i, "A").Value <> ""
i = i + 1
Loop
k = 1
Do While ActiveSheet.Cells(k, "A").Value <> "TU"
k = k + 1
Loop
Rows(k).Select
Selection.Copy
Rows(i).Select
Selection.Insert Shift:=xlDown
Dla cel�w pomocniczych w kolumnie A wpisalem "TU", mo�e mo�na to zrobi�
pro�ciej.
Czy moglbym to zrobic bez wpisow w kolumnie "A" - "TU". Np. jesli ktos
skasuje wiersz (ale bez schowanej kolumny A z wyrazem "TU") makro bedzie
zle dzialalo. Jak to ewentualnie mozna obejsc ???
nie b�dziesz mia� wi�cej jak 255 wierszy ???? bo jak tak to ma�a ta zmienna :)
lepiej mieďż˝ margines ;) co najmniej Integer - to juďż˝ ponad 32tys.
> i = 1
> Do While ActiveSheet.Cells(i, "A").Value <> ""
> i = i + 1
> Loop
> k = 1
> Do While ActiveSheet.Cells(k, "A").Value <> "TU"
> k = k + 1
> Loop
> Rows(k).Select
> Selection.Copy
> Rows(i).Select
> Selection.Insert Shift:=xlDown
takie kwiatki z "Selection" to Excel sam zapisuje :) lepiej nie robi� dooko�a
jak on ;)
Rows(k).Copy
Rows(i).Insert Shift:=xlDown
No i zamiast takich p�tli mo�na jeszcze zrobi� przechodzenie w kolekcji, np:
Dim c As Range
For Each c In Range("A1:A255")
If c = "" Then
i = c.Row
Exit For
End If
Next c
Lub najlepiej funkcjďż˝ szukaj dla zakresu, np:
Dim szuk As Range
Set szuk = Range("A1:A255").Find(What:="TU", LookAt:=xlWhole,
LookIn:=xlValues)
k = szuk.Row
lub od razu
szuk.Rows.EntireRow.Copy
Pozdrawiam
Wielkie dzieki, czy mozna jednak unikanac wyrazu TU w kolumnie A ?
nie do ko�ca rozumiem jaki efekt pr�bujesz osi�gn�� .... (po co to kopiowanie i
do jakich cel�w nale�y)
bo wszystko wydaje mi siďż˝ strasznie zagmatwane ;)
Rozumiem �e chcesz kopiowa� wiersze_A razem z nast�pnym wierszem_B -> na sam
koniec wierszy
a wiersze_B majďż˝ siďż˝ powielaďż˝ od razu "pod sobďż˝"
Pomys� z etykietami w kolumnie ukrytej jest dobry ... w jaki� spos�b musisz
identyfikowa�/rozr�nia� te dwie grupy wierszy.
Mog�aby to te� by� jaka� charakterystyczna w�a�ciwo�� lub warto�� ... np. kolor
t�a lub ramka ... ew. w�a�ciwo�� .id kom�rki.
Wg powy�szych za�o�e� (tego co zrozumia�em) maj�c dowolne dane w arkuszu, a w
wybranych kom�rkach pierwszej kolumny "A" opisy "wiersz_A" lub "wiersz_B" ....
przyk�adowo:
wiersz_A 1 234 34 2
wiersz_B fsf gdg dfgd dfgd
wiersz_B fsf gdg dfgd dfgd
wiersz_B fsf gdg dfgd dfgd
wiersz_A 1 234 34 2
wiersz_B fsf gdg dfgd dfgd
wiersz_B fsf gdg dfgd dfgd
Zdarzenie arkusza dla podw�jnego klikni�cia w kom�rk� (tak dla przyk�adu by nie
u�ywa� przycisk�w i nie komplikowa� problemu)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim KomA As Range
Set KomA = Cells(Target.Row, 1)
Select Case KomA.Value
Case "wiersz_A"
Target.Resize(2, 1).EntireRow.Copy
Rows(KomA.CurrentRegion.Rows.Count + KomA.CurrentRegion.Row).Insert
Case "wiersz_B"
Target.EntireRow.Copy
Target.EntireRow.Cells(2, 1).Insert
End Select
End Sub
Powinno dzia�a� jak pisz� .... prze�wicz ... mo�e co� rozwi��e
Oczywiscie ze mozna, jesli znajdziesz inna, charakterystyczna ceche,
wystepujaca w twoim kopiowanym zakresie danych. Komputer musi znalezc cos,
co dla niego bedzie znacznikiem, w tym najprostszym przypadku bedzie to
wartosc w kolumnie A, ale rownie dobrze moze to byc kombinacja komorek,
komentarz, kolor komorki czy tekstu obszar nazwany albo dziesiatki innych
atrybutow...
Ale jesli nie widzimy twojej pracy, to nie mamy co wrozyc :)
Pozdrawiam
Michal
Juz tlumacze potrzebe opisana przeze mnie:
w wierszu A mam wymog (tekst dla danego zadania) = ktory wyswiatla sie
po wyborze tego samego wymogu tekstowego w suwaku Pola kombi formantu
Active X umieszczonego w innym miejscu. Warunek ten jest jednym
przykladowo z 10. Teraz stworzylem makro ktore przerzuca ten tekst z
wiersza A do wiersza B ponizej. Nastepnie kolejny wybor w polu kombi -
skutek tego pojawia sie nowy tekst w wierszu A - i teraz znow uruchamiam
makro naciskiem CommandButton i ten tekst przeskakuje za ten tekst z
wiersza B, Zalozmy do wiersza C. Nastepnie kolejny wybor - nowy tekst w
wierszu A - uruchamiam makro - warunek przeskakuje do wiersza C. Itd,
itd. Wazne jest dla mnie ze w tych wierszach B i C moge te teksty
edytowac - dopisywac jakies szczegolne warunki - ale juz na bazie
przykladow. Ponizej tych wierszy A, B, C sa wolne (puste) wiersze - wiec
zastosowane tu wczesniej opisane instrukcje z wyrazem ukrytym w kolumnie
dzialaja. Dalej jednak (jeszcze) ponizej - sa jednak rozne kolejne
rurbryki do uzupelnienia. Powyzej wiersza nazwijmy je A, B, C - sa takze
rozne rubryki do uzupelnienia - nieraz tez z makrami wstawiajacymi
wiersze itp. wiec - moze okazac sie ze procedura z wyszukiwaniem wyrazu
trzymajmy sie dalej "TU" zawiedzie, np. wskutek wstawienia jakiegosc
wiersza powyzej bez tego wyraz - co finalnie spowoduje skopiowanie
naszego "wiersza A" nie ponizej niego - ale gdzies powyzej tej czesci
roboczej. Przepraszam za przydlugi opis - i dziekuje bardzo za
dotychczasowa pomoc, choc nie ukrywam nadal na nia licze, caly czas tez
oczywiscie probujac szukac rozwiazan i zglebiajac Wasze porady od strony
technicznej jezyka VBA. Pozdrawiam
Wiesz, powiem szczerze, ze przeczytalem ten opis dwa razy i go nie
rozumiem...
To pewnie ze zmeczenia :)
Ale moze byloby prosciej, gdybys wystawil swoj plik w internet? zmien dane
na jakies testowe i wrzuc to do jakiegos sendspace.pl lub wrzucaj.pl czy
inny serwer hostujacy pliki...
Jakby co, jutro jeszcze raz sprobuje zrozumiec, ale nie ukrywam, ze latwiej
byloby z przykladem :)
Pozdrawiam
Michal
Ponizej tych wierszy jest ten nasz przedmiotowy wiersz A - czyli np. od
wiersza 11. W nim jest pole suwaka z 10 wyborami - np. jedna z nich "Ja
nizej podpisany .... o�wiadczam i� ...", kolejny "Zobowiazuje si� do
..." i kolejne pola wyboru. S� to gotowe formu�ki tekstowe do
uzupe�nienia. Gdy wybierze sie jedna z nich - jest ona wyswietlana w
polu 12. Poprzez makro uruchamiane przyciskiem - formulka tekstowa ta
jest przrzucana do wiersza 13. Wtedy mozna wybrac kolejna formulke
tekstowa z suwaka - pojawia sie ona w w miejsce poprzedniej w wierszu 12
- i potem znow poprzez uruchomienie makra (wykorzystujacego tekst "TU")-
przerzucamy ja ponizej przezrzuconej poprzedniej - czyli do wiersza 14
itd. itd
W dalszej strukturze tego arkusza - powiedzmy wierszach 20-30 sa inne
rozne pola do uzupelnienia.
Moja obawa odnosnie wyrazu pomocniczego "TU" w ukrytej kolumnie "A" -
poprzez roznie kombinacje w wierszach 1-10 i wierszach 20-30 moge np.
przykladowo wstawic wiersz, w ktorym w kolumnie A nie bedzie wyrazu "TU"
jako "indeksu", ktory wykorzytsywany jest do identyfikacji czy dany
wiersz jest "pusty" - do potencjalnego zapelnienia. Wtedy makro uzywane
do kopiowania tekstu z wiersza 12 - moze zle zinterpretowac, ktory
wiersz jest pusty :(
Je�eli chodzi "tylko" o powielenie danego wiersza na ko�cu listy "pod suwakiem"
to spraw� powinno za�atwi�:
Dim KomS As Range
Set KomS = Range("L20") 'kom�rka w kt�rej jest suwak z wyborem
KomS.Offset(1).EntireRow.Copy 'kopiujemy wiersz o jeden ni�ej
KomS.End(xlDown).Offset(1).EntireRow.Insert xlShiftDown 'wstawiďż˝ na koniec listy
> Moja obawa odnosnie wyrazu pomocniczego "TU" w ukrytej kolumnie "A" - ......
i wtedy nie musisz ju� martwi� si� w og�le �adn� ukryt� kolumn� bo jest
niepotrzebna ;)
Jedyny problem w tym, ze komorka z suwakiem , niech to bedzie powyzsza
"L20" (w zwiazku z faktem roznych perturbacji - w wierszach powyzej
(wspomnianych wierszach 1-10) moze byc raz w L20 a raz np. w L21 albo
L22 itd. Wyraz "TU" i odpowiednia instrukcja identyfikowala jego
polozenie za kazdym razem. Ale jak pisalem czasami uzycie i koniecznosc
uzywania tego wyrazu jest problematyczna. ???
aha .. ale ten problem rozwi��emy przez nazwanie zakresu kom�rki (przyk�adowej
"L20") ...
nazywasz ten zakres jednokom�rkowy dajmy na to "Suwak1" i wtedy ju� odwo�ujemy
sie poprostu tak:
Range("Suwak1").Offset(1).EntireRow.Copy 'kopiujemy wiersz o jeden ni�ej
Range("Suwak1").End(xlDown).Offset(1).EntireRow.Insert xlShiftDown 'wstawiďż˝ na
koniec listy
Nazwane zakresy Excel zawsze przeadresuje w zale�no�ci co i ile si� doda
powy�ej.
Range("Suwak1").End(xlDown).Offset(1).EntireRow.Insert xlShiftDown
pojawia si� b��d w edytorze VBA ???
Probowalem tez:
KomS.End(xlDown).Offset(1).EntireRow.Insert Shift:=xlDown
ale nie pomaga ??
ale jaki b��d ? (u mnie dzia�a poprawnie)
zdefiniowa�e� r�cznie nazw� "Suwak1" dla kom�rki ??
gdzie wpisa�e� kod ? do modu�u czy w arkuszu ?
i jeszcze zobacz co zrobi (wpisz tylko w okienko Immediate w VBA):
Range("Suwak1").End(xlDown).EntireRow.select
lub/oraz
Range("A1").End(xlDown).Offset(1).EntireRow.select
kt�r� linijk� zaznaczy?
jakiego masz excela ?
kod jest prosty i powinien dzia�a� (ci�ko debugowa� na odleg�o�� :) hihi)
mo�e jest problem z wyznaczeniem ko�ca listy [.End(xlDown)] gdy nast�pna
kom�rka jest pusta itd. -> zaznaczy dopiero nast�pn� z zawarto�ci� lub
ostatni� w arkuszu (gdy jest pusto do ko�ca)
Po�wicz troch� na sucho (w Immediate) i zobacz metod� pr�b i b��d�w, gdzie
le�y przyczyna.
Na razie jeszcze nie definiowalem komorki, chcialem potreniowac na
komorce np. B2. Zatem wpisuje cala makro do modulu, np;
Sub Makro()
Dim KomS As Range
Set KomS = Range("B2")
KomS.Offset(1).EntireRow.Copy
KomS.End(xlDown).Offset(1).EntireRow.Insert xlShiftDown
End Sub
i p ojawia sie komunikat o bledzie - zaznaczenie na zolto wiersza:
KomS.End(xlDown).Offset(1).EntireRow.Insert xlShiftDown
?? gdzie jest blad w instrukcji lub po mojej stronie ?
Wersja VBA - office 2007 - 6.5
Na razie jeszcze nie definiowalem komorki, chcialem potreniowac na
komorce np. B2. Zatem wpisuje cala makro do modulu, np;
Sub Makro()
Dim KomS As Range
Mysle, ze koncepcja Krzycha (z uzyciem nazw zakresow) jest dobra i moze sie
tutaj spokojnie sprawdzic...
Ponizej w miare prosty przyklad, ktory moglbys zaadaptowac u siebie.
Caly pomysl polega na tym, zeby znalezc zakres komorek, ktory byl wpisany
jako ostatni, a nastepnie po twoich operacjach nazwac ten nowo skopiowany
zakres komorek i usunac nazwe ze starego zakresu.
Przyjmijmy, ze zakres komorek bedzie sie nazywal "OSTATNIE", a obejmowal
bedzie tylko to pole w kolumnie A, w ktorym "kiedys" byl napis "TU"
(oczywiscie mozesz sobie potem to spokojnie zmienic i dostosowac).
Zeby zaczelo to dzialac, powienies znalezc ostatnie wystapienie twojego
slowa "TU", a nastepnie z menu Wstaw->Nazwa->Definiuj utworzyc nowa nazwe
"OSTATNIE" i wskazac kliknieciem to ostatnie slowo "TU".
od tego momentu juz mozna skasowac slowa, gdyz wlasnie nazwales obszar i tym
samym zyskales inny znacznik pola.
Dobrze, teraz troche VBA, bardziej pogladowe:
Dim nazwa As Name
' tutaj przeszukujemy wszystkie nazwy, a jak znajdziemy nazwe "OSTATNIE", to
' odczytujemy numer wiersza i kasujemy
For Each nazwa In ActiveSheet.Names
If nazwa.Name = ActiveSheet.Name & "!OSTATNIE" Then
wiersz = nazwa.RefersToRange.Row
nazwa.Delete
End If
Next nazwa
' ....
' tutaj sobie kopiujesz i robisz inne rzeczy z uzyciem zmiennej <wiersz>
' ....
' a tutaj zakladasz od nowa nazwe OSTATNIE, ale juz w innym miejscu, niz
poprzednio,
' np. o 3 wiersze nizej
ActiveSheet.Names.Add Name:="OSTATNIE", RefersTo:="=" & ActiveSheet.Name &
"!$A$" & wiersz + 3, Visible:=True
Pozdrawiam
Michal
ok .. tylko ca�y czas nie podajesz numeru i opisu b��du
i sprawd� zachowanie po pr�bach z zaznaczaniem co poda�em w drugim po�cie.
na moje musi dzia�a� --> zak�adaj�c, �e masz co� poni�ej B2 wpisane !
... jak nic nie ma, to koniec listy jest poza arkuszem i to mo�e powodowa�
b��d ! :)
(przecie� B2 to kom�rka z polem wyboru, kt�re ma wstawia� w B3 jakie�
opisy - wg. Twoich za�o�e�)
... metoda .End(xlDown) przeskoczy do ko�ca listy zakresu dla kt�rego jest
wywo�ywana - ale musi co� by� - bo inaczej koniec listy to koniec arkusza.
Application-defined or object-defined error -> mam teďż˝ takie coďż˝ gdy jest pusto
w danych kom�rkach ... czyli gdy skacze na koniec arkusza
dzia�anie .End(xlDown) mo�na �atwo sprawdzi� r�cznie
W arkuszu zaznaczasz kom�rk� B2 i naciskasz klawisze END + strza�ka w d� ...
przeskoczysz do "ko�ca listy" ... wiersz ni�ej powinno wklei� dane.
wi�cej zawsze sie da zbada� po b��dzie w trybie przerwania w okienku Immediate
VBA, przyk�ady:
?KomS.address
$B$2 <- tak powinno wypisaďż˝ - podaje by sprawdziďż˝ ... dalej zobacz:
?KomS.End(xlDown).address
?KomS.End(xlDown).Offset(1).address
?KomS.End(xlDown).Offset(1).EntireRow.address
jakie adresy uzyskasz ?
i inne podobne kombinacje ... zmieniaj�c r�ne w�a�ciwo�ci powiniene� ustali�
gdzie jest b��d
Bij� si� w pier�, testowa�em procedur� nie do ko�ca w warunkach jakie
opisa�em. Procedura jak najbardziej dzia�a - instrukcja jest poprawna.
Chyl� czo�a - i dzi�kuj� bardzo. Ta metoda idealnie pasuje do warunk�w,
kt�re opisa�em.
Mam jeszcze zapytanie - pomyslalem, ze moglbym je wykorzystac takze w
innych czesciach formularza - do kopiowania wierszy, ich powielania, np.
w celu dodania kolejnego rekordu.
Obecnie - zapisywany jest dany rekord (tabelka) - i jesli istnieje
koniecznosc kopiuje (wstawiam) kolejny tabelki, poprzez wymienione tu
juz w tym watku dyskusji instrukcje:
i = 1
Do While ActiveSheet.Cells(i, "A").Value <> "TU"
i = i + 1
Loop
Rows(i + 1 & ":" & i + 4).Copy
Rows(i + 5).Insert Shift:=xlDown
W celu wyczyszczenia zapisanego wczeniej czesci rekordu stosujďż˝ taka
instrukcjďż˝ w dalszej czesci kodu:
Range(Range("D" & i + 1), Range("F" & i + 3)).ClearContents
Wada tego kodu jest to - ze nie kopiuje on wiersza na koniec listy, lecz
na poczatek, co nie jest dobre np. przy dopisywaniu rekordow - w ktorych
wazna jest kolejnosc.
Moje pytanie: czy mozna by bylo zastosowac powyzszy opisana przez Ciebie
kod (... KomS.End(xlDown).Offset(1).EntireRow.Insert xlShiftDown...)
takze do tego przypadku.
Co wazne dodam - rekord - wiersz (ktory kopiuje) ma pod soba jeden pusty
wiersz - ktory "sluzalyby" tu za koniec listy. Kolejna rzecz - tak jak
pisalem rekord jest kopiowany razem z ta "przerwa", wiec przy dwoch
takich przerwach - pojawi�by sie ten sam problem, jak z wyrazem "TU" i
koniecznoscia zdefiniowania nazwy pola "OSTATNIE" w metodzie, o ktorej
pisal Michal.
Postaram sie to jeszce zobrazowac dodatkowo jak dziala powyszy kod (efekt):
a)
1 - wiersz z rekordem (1)
a - wiersz pusty tym rekordem (1)
teraz zapisuje rekord, np imie i nazwisko
uzywam makra ..
b) efekt:
1 - wiersz z rekordem - ale z pustymi juz polami do uzupelnienia (2)
a - wiersz pusty tym rekordem (2)
1 - wiersz z rekordem (zapisany)(1)
a - wiersz pusty tym rekordem (1)
zapisuje pusty rekord i kolejne uzycie makra...
c)
1 - wiersz z rekordem - ale z pustymi juz polami do uzupelnienia (3)
a - wiersz pusty tym rekordem (3)
1 - wiersz z rekordem (zapisany)(2)
a - wiersz pusty tym rekordem (2)
1 - wiersz z rekordem (zapisany)(1)
a - wiersz pusty tym rekordem (1)
itd, itd...
Pod tym wszystkim dalszej czesci - inne czesci formularza.
Prosze o wskazowki. dzieki.
za skomplikowanie ... za dużo range :) ... wystarczy po prostu:
Range("D" & (i + 1), "F" & (i + 3)).ClearContents
> Wada tego kodu jest to - ze nie kopiuje on wiersza na koniec listy, lecz
> na poczatek, co nie jest dobre np. przy dopisywaniu rekordow - w ktorych
> wazna jest kolejnosc.
>
> Co wazne dodam - rekord - wiersz (ktory kopiuje) ma pod soba jeden pusty
> wiersz - ktory "sluzalyby" tu za koniec listy. Kolejna rzecz - tak jak
> pisalem rekord jest kopiowany razem z ta "przerwa", wiec przy dwoch
> takich przerwach - pojawiłby sie ten sam problem, jak z wyrazem "TU" i
> koniecznoscia zdefiniowania nazwy pola "OSTATNIE" w metodzie, o ktorej
> pisal Michal.
Dim szuk As Range
With Range("D1:D2000") 'zakres dla jakiego szukamy (max. 2000 wierszy)
Set szuk = .Find(What:="", LookAt:=xlWhole, LookIn:=xlValues)
'dopóki nie znajdziemy dwóch pustych po sobie
Do While szuk.Offset(1) <> ""
Set szuk = .FindNext(szuk)
Loop
End With
Rows("1:2").Copy 'zakres jaki kopiujemy
szuk.Offset(1).EntireRow.Insert
Application.CutCopyMode = False 'czyszczenie "schowka"
Dopasuj tylko zakresy jakie są odpowiednie w Twoim arkuszu
--
IDKrzych
"Jakkolwiek będzie - będzie inaczej, aniżeli sobie wyobrażamy
- ponieważ między Dobrem a Złem znajdujemy się w życiu i w świecie
wielowymiarowym,
w którym dokumentnie pomieszane jest Przypadkowe z Nieuchronnym."
(S. Lem 1999)
Wielkie, dzieki, powoli tracilem nadzieje :))
Nie wiem czy do konca zrozumielismy sie - w niuansach - zamieszczam
zatem (co juz powinienem zrobic wczesniej - za co przepraszam) plik z
tym co mam - jak to wyglada:
Tak jak wczesniej pisalem - chcialbym by wypelnione pola (D:D10) oraz
(D13:18) po nacisnieciu nacisku NOWY1 oraz NOWY2 byly na poczatku i nowe
pole grupowane pod spodem danej sekcji. Obecnie jest odwrotnie (jak
pisalem utrudnia to uzupelnianie danych).
IDKrzych proszďż˝ Ciďż˝ jesli mozesz o dopasowanie Twojego kodu do tego
przypadku. Mi jakos srednio wychodzi :( Poza tym chyba �le tlumaczylem z
tymi "przerwami" - czyli pola, np. B11 lub B19.
PS: w obecnym arkuszu - ze stara metoda z wyrazem "TU..." ukryta jest
kolumna B.
Z gory bardzo dziekuje.
Pozdrawiam
Sorki, b��d - ukryta jest kolumna A (nie B).
a niesłusznie ;) :)
> Nie wiem czy do konca zrozumielismy sie - w niuansach - zamieszczam
> zatem (co juz powinienem zrobic wczesniej - za co przepraszam) plik z
> tym co mam - jak to wyglada:
i od razu jaśniej wygląda problem :)
> Tak jak wczesniej pisalem - chcialbym by wypelnione pola (D:D10) oraz
> (D13:18) po nacisnieciu nacisku NOWY1 oraz NOWY2 byly na poczatku i nowe
> pole grupowane pod spodem danej sekcji. Obecnie jest odwrotnie (jak
> pisalem utrudnia to uzupelnianie danych).
No to może takie rozwiązanie-> Nazywamy zakresy:
Nagłówek X czyli "B5" > "NaglDane1"
Nagłówek Szczegóły "B12" > "NaglSzczegoly"
Nagłówek Różne Dane (lub pustą komórkę w tym miejscu) "B20" > "NaglRozne"
Nazwy możesz oczywiście wybrać dowolne, byleby pozmieniać w kodzie
Sub Makro1()
ileWierszy = 5
Set Skad = Names.Item("NaglDane1").RefersToRange
Set Dokad = Names.Item("NaglSzczegoly").RefersToRange
Skad.Offset(1).Resize(ileWierszy + 1).EntireRow.Copy
Dokad.EntireRow.Insert Shift:=xlDown
Skad.Offset(1).Offset(0, 1).Resize(ileWierszy, 3).ClearContents
Skad.Offset(1).Offset(0, 1).Select
Application.CutCopyMode = False
End Sub
Sub Makro2()
ileWierszy = 6
Set Skad = Names.Item("NaglSzczegoly").RefersToRange
Set Dokad = Names.Item("NaglRozne").RefersToRange
Skad.Offset(1).Resize(ileWierszy + 1).EntireRow.Copy
Dokad.EntireRow.Insert Shift:=xlDown
Skad.Offset(1).Offset(0, 1).Resize(ileWierszy, 3).ClearContents
Skad.Offset(1).Offset(0, 1).Select
Application.CutCopyMode = False
End Sub
można .. proponuję tak by na końcu były pola do wypełniania
..tylko jak dobrze pamiętam (bo wątek dość długi się robi :) ) był tam
jakiś selektor co wpisywał jakieś napisy w puste pola ... trzeba by i jego
kod zmodyfikować by wpisywał na "końcu listy" w puste pola.
a kod w takim razie:
Sub Makro2()
ilewierszy = 6
'wersja tworzaca tylko puste tabelki na koncu
Range("NaglRozne").Resize(ilewierszy + 1).EntireRow.Insert Shift:=xlDown
Range("NaglSzczegoly").Offset(1).Resize(ilewierszy + 1).EntireRow.Copy
Range("NaglRozne").Offset(-(ilewierszy + 1)).Resize(ilewierszy +
1).EntireRow.PasteSpecial xlPasteFormats
Range("NaglRozne").Offset(-(ilewierszy + 1)).Offset(0, 1).Select
Application.CutCopyMode = False
'wersja kopiujaca tabelkę na koniec i kasująca zawartość
Range("NaglSzczegoly").Offset(1).Resize(ilewierszy + 1).EntireRow.Copy
Range("NaglRozne").Resize(ilewierszy + 1).EntireRow.Insert Shift:=xlDown
Range("NaglRozne").Offset(-(ilewierszy + 1)).Offset(0,
1).Resize(ilewierszy, 3).ClearContents
Range("NaglRozne").Offset(-(ilewierszy + 1)).Offset(0, 1).Select
Application.CutCopyMode = False
End Sub
--
nie rozumiem ...
na moje bez znaczenia jakie i ile jest modułów ... na danym arkuszy musisz
tylko zdefiniować odpowiednie nazwy odnoszące się do "odpowiednich" miejsc
- z zakresem na poziomie arkusza, bo wtedy możesz mieć na innych arkuszach
też takie same nazwy i makro będzie nadal działać (na innych zakresach)
w naszym przypadku ważne by w każdym ew. arkuszu nazwać:
komórkę nagłówka pierwszej tabelki -> "NaglDane1"
komórkę nagłówka drugiej tabelki -> "NaglSzczegoly"
komórkę o dwie niżej (jeden wiersz odstępu) od końca drugiej tabelki ->
"NaglRozne"
jeżeli chodzi o różne ilości wierszy w modułach - dlatego jest zmienna
[ilewierszy] by można było ustawić dowolną "wysokość modułu"
troszkę jest tych zależności, i jeżeli makro ma działać na "bardzo
dowolnych" szablonach z tabelkami trzeba by je jeszcze "okrasić" metodami
kontroli "co ? ile ? i gdzie ?" ... wszystko do zrobienia i w większości
za pomocą tych samych metod jakie już w tym wątku padały.