Nie wiem jakie w ogóle planujesz operacje w tym pliku. W kolumnie A masz wpisaną numerację, więc nie brałem pod uwagę wstawiania/usuwania wierszy. W tej chwili zmieniłem to w ten sposób, że jeśli operacja dotyczy komórek całego wiersza lub więcej, to nie jest zapisywana do historii.
... Przy użuciu wyskakuje mi błąd Type mismatch runtime error 13 i wskazuje na linijkę : ... :) wpisać poprawną konstrukcję dla: Selection ', a nie do zawartości komórki wyznaczonej tym zaznaczeniem, a równym " CAŁKOWITY KOSZT STANU *", np.: [syntax=vbscript] Range("A" & Selection.Row) Like "CAŁKOWITY KOSZT STANU*"[/syntax]
Tak na szybko - jak wygląda wartość datazlecenia? Nie ma tam przypadkiem znaków niedozwolonych do zapisania pliku? Np. "\", "/"
Po pierwsze: brakowało .Value po Cells(i, 9) Po drugie: pierwsza odczytana pozycja z arkusza to "FTC.023". W skoroszycie nie ma arkusza o takiej nazwie, więc nawet gdyby to .Value było i tak wystąpiłby błąd. Instrukcję: On Error Resume Next dałeś dopiero po tej linii, która generuje błąd. Myślałem, że jest to zamierzone (tzn. że w pierwszym obiegu pętli...
Rozwiązań jest naprawdę sporo Zgadzam się z tym poglądem i choć autor postu chyba zasypał się w tych rejestrowanych makrach :-) to podsuwam nieco inne rozwiązanie tego zadania marek003 obawiam się uruchomienia takiego masowego wydruku na nieokreślonej drukarce (jednostronna czy dwustronna) i dlatego proponuję rozwiązanie z exportem wszystkich podzleceń...
Pyta za to okno wywołane w VBA. Tutaj [url=https://stackoverflow.com/questions... - jak uruchomić procedurę BeforeSave No i trochę trzeba pokombinować. Np (wklej poniższe w ThisDocument) [syntax=vbscript]Private WithEvents App As Word.Application Private Sub Document_Open() Set App = Word.Application...
To bylo tylko fragment makro Wstaw jak w Ciebie - 'On Error Resume Next' - gdy nie ma pustych komorek(xlCellTypeBlanks)
Nie należy umieszczać w kodzie [syntax=vbscript]On Error Resume Next[/syntax]na wszelki wypadek. Kontrola błędów umożliwia panowanie nad kodem. Można włączać ignorowanie błędów w ściśle określonych miejscach programu, sprawdzać czy istotnie błąd wystąpił, obsługiwać taki przypadek, a później niezwłocznie przywracać kontrolę błędów. Program z totalnie...
Zrobiłem coś takiego i dalej nic, a co gorsza nawet nie ma żadnego błędu a baza msql dalej nie posortowana. Proszę dodarcie coś mądrego co tu może być nie tak. Połączenie z bazą działa na 100% bo dodaję i usuwam rekordy Nie gorączkuj się, nie wiem jak sprostać Twojemu wyzwaniu dodania czegoś mądrego, ale szczerze mówiąc "problem" jest tak prozaiczny,...
A jaki sposób mogę "masowo" stworzyć chekboxa dla 1200 pozycji Możesz spróbować tak: zaznaczyć odpowiedni zakres w kolumnie dla checkboxów, a następnie uruchomić makro: [syntax=vbscript]Sub InsertCheckBoxes() Dim Rng As Range Dim WorkRng As Range Dim Ws As Worksheet On Error Resume Next xTitleId = "Excel" Set WorkRng = Application.Selection Set WorkRng...
także wszystko powinno działać No właśnie nie. Co do twojego kodu to jak chcesz to [syntax=vbscript]Sub Makro_K() On Error Resume Next Range("I20:O119").SpecialCells(xlCellTyp... = "=IF(R9C4=R18C,""X"","""")" End Sub[/syntax]
Witaj [syntax=vbnet]Sub CellToComment() Dim Rng As Range Dim WorkRng As Range On Error Resume Next xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection For Each Rng In WorkRng koment = koment & Rng.Value & vbLf Next WorkRng(1).Offset(WorkRng.Count).NoteTex... Text:=koment End Sub [/syntax]
Sprawdź (dodane od kolegi (at)Maciej Gonet ) [syntax=vbscript]Sub Test() Set zakres = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row) On Error Resume Next Set zakres = zakres.SpecialCells(xlCellTypeVisible) On Error GoTo 0 wynik = zakres.Text If IsNull(wynik) Then Cells(1, 2) = "Różne" Else Cells(1, 2) = wynik End If End Sub [/syntax] ps zapędziłem...
Da się: http://obrazki.elektroda.pl/8027992500_1...
nazwy firm w zależności od statusu tylko na dzień dzisiejszy :?: Jeśli ten warunek jest istotny :?: to te nazwy firm będą jedynie w jednym wierszu (dane dla dnia dzisiejszego :D ) np. tak jak na zrzucie i w załączonym pliku :ok: 1088589 1088592 Jeśli koleżanka preferuje rozwiązania oparte o VBA :?: to można tu zastosować kod, który przy otwarciu pliku...
: ) ... a z właściwej strony tam zaglądasz ... : ) ? ... np. z ustawieniami "na sztywno": [syntax=vbscript]Sub abc() Dim msc, mscS$, schmt$, otwarty As Object msc = Trim(InputBox("Wprowadź numer miesiąca z przedziału 1-12", "Podaj miesiąc", "1")) msc = Abs(Fix(Val(msc))) If msc < 1 Or msc > 12 Then Exit Sub mscS = Choose(msc, "Styczeń", "Luty",...
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next r = Date - Target.Cells If Target.Column = 2 And r > 30 Then w = Target.Row Cells(w - 1, 5) = "" Cells(w, 5) = "" End If End Sub [/syntax]
... ALE BABOL z tym dniem ... :) ... : dzien = Sheets(ark_wpis).Range("a2").Value dzien = CInt(ThisWorkbook.ActiveSheet.Range("a2"... powinno być oczywiście tak : dzien = CInt(ThisWorkbook.Sheets(ark_wpis).Range... [syntax=vba]Sub log_05() ... ark_log = "log" ... 'Zabezpieczenie przed próbą "przemycenia" do zmiennej liczbowej wartości...
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Column = 5 Then nw = Sheets("Logistyka").Cells(Rows.Count, "A").End(xlUp).Row + 1 If nw = 2 Then nw = 1 w = Target.Row Range(Cells(w, 1), Cells(w, 5)).Copy Sheets("Logistyka").Cells(nw, 1).PasteSpecial xlPasteValues End If End Sub [/syntax] Kod na tyle prosty,...
Sprawa 1 Trochę niejasna. Czy chcesz sformatować w arkuszu komórkę Cells(x, "S") jako walutową, czy chcesz taką sformatowaną wartość dołączyć do wiadomości, czy jedno i drugie? Bo to są rzeczy niezależne. Jeśli sformatować w arkuszu, to kod: [syntax=vbscript]Cells(x, "S").NumberFormat = "#,##0.00 zł"[/syntax]lub ręcznie. Jeśli chcesz sformatować wartość...
Nie to zdarzenie, nie taka składnia, reszta OK...[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A6")) Is Nothing Then On Error Resume Next 'gdybyś czyścił zakres Application.EnableEvents = False Target.Value = Replace(Target.Value, " ", Chr(10)) Application.EnableEvents = True End If End Sub[/syntax]
:arrow: bobo InStr Trzeba podstawić[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Dim test As Integer If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("Q58:V119")) Is Nothing Then test = InStr(1, Target.Value, "+") If test = 0 Then Exit Sub Application.EnableEvents = False On Error Resume Next Target.Value = "=" & Target.Value...
Mi wyszedł taki UDF: [syntax=vb]Function Pierwsza_Usluga(Uslugi As String, Data_Uslugi As String) As String Dim tbl_Data() As Variant Dim tbl_Uslugi() As Variant Dim tmpDate As Variant Dim tmpUsluga As String Dim i% On Error Resume Next tbl_Data() = Application.Transpose(Split(Data_Uslugi, "|")) tbl_Uslugi() = Application.Transpose(Split(Uslugi, "|"))...
Witam Zobacz tak [syntax=vbnet]Sub Wyslij() Application.ScreenUpdating = False Dim OutApp As Object Dim OutMail As Object Dim Szablon As String Dim strbody As String Szablon = getFile("\\Poluser1\dyspozytorzy\Asysten... If Szablon = "" Then Exit Sub Set wd = CreateObject("Word.Application") Set doc = wd.documents.Open(Szablon)...
Sprawdź (wpisz nazwę swojego konta i temat tej wcześniej wysłanej wiadomości) [syntax=vbscript]Sub MailExcelVbaOutlook() 'automatyczny mail Dim adres1 As Variant Dim OutApp As Object Dim OutMail As Object Dim SigString As String Dim Signature As String Dim strbody As String Dim folder As Object, w As Object Set OutApp = CreateObject("Outlook.Application")...
Może przez szukanie w pętli z wykorzystaniem obsługi błędu. Np[syntax=vb]On Error Resume Next Do While Err = 0 kol = Rows(1).Find(what:="MSISDN", lookat:=xlWhole).Column kol = Rows(1).Find(what:="Kod Sprzedawcy", lookat:=xlWhole).Column Columns(kol).Delete Loop[/syntax]
Po mojemu powinno działać coś takiego (nie testowane)[syntax=vb]Sub Przycisk1_Kliknięcie() Dim path1 As String, path2 As String, plik As String Dim folder As Object, pfolder As Object Dim dta1 As Date, dta2 As Date, nazwaMin As String, nazwaMax As String Application.ScreenUpdating = False path2 = "\\Serwer\test" Set folder = CreateObject("Scripting.FileSystemObject...
Ja bym zrobił tak, że po wpisaniu nazwy urządzenia wyskakuje okno gdzie podajsz ilość pobrania lub oddania. With Target If .Address(0, 0) = "E2" Then Application.EnableEvents = False ilosc = InputBox("Ile pobrano?") If .Value <> Empty Then On Error Resume Next wrs = Columns(1).Find(what:=.Value, lookat:=xlWhole).Row Err.Clear If wrs <> Empty...
Powinienem wyraźniej zaznaczyć, że chodzi o zatrzymanie procedury gdy plik jest używany przez kogoś innego. Rozumuję następująco On Error Resume Next Set plik = Workbooks("RAPORT DZIENNY.xls") If Err = 9 Then 'jeśli próba przypisania zakończona błędem On Error GoTo 0 Set plik = Workbooks.Open(Filename:=ThisWor... &...
Staram się... OK, nagrałem sobie makro, usunąłem co niepotrzebne, dodałem co niezbędne i wyszło coś takiego Znalazłem taki kod ale nie wiem jak go pod siebie przerobić Nie mam pojęcia czy zakres dla procedury zdarzeniowej (określony argumentem: "Me.ListObjects("Lista1").Range.Columns(... ma u Ciebie zastosowanie, czy nie. Może bierzemy się za przerabianie...
Witam w nowym tygodniu, Musi Pan w swoim makro zdefiniować niestandardową obsługę błędów. Może to polegać na wpisaniu na początku kodu linijki: On Error Resume Next Dalej w kodzie testuje Pan zawartość obiektu Err. W Pana kodzie w linijce po instrukcji Name powinien Pan dopisać: If Err.Number = 0 Then Cell.Offset(0,3) = "OK" Else Cell.Offset(0,3) =...
Nie znam się, ale spróbuj tak: [syntax=vb]Sub szuaknieall() znal = Null On Error Resume Next For Each Arkusz In ThisWorkbook.Worksheets Arkusz.Activate znal = Cells.Find(What:="lolek", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate If znal Then Exit Sub Next Arkusz End...
Na początek: Ad.1 i 3 Wstaw nowy moduł do pliku 'z_którego_kopiuje.xls' i wklej poniższy kod [syntax=vba]Option Explicit Sub KopiujAle() Dim fd As FileDialog, wkb As Workbook, test As String Set fd = Application.FileDialog(msoFileDialogOpen... With fd .InitialFileName = ThisWorkbook.Path .AllowMultiSelect = False .Filters.Clear .Filters.Add "Pliki Excela",...
[syntax=vbscript]Sub Dzialaj() Application.ScreenUpdating = False Dim Tekst As String Sciezka = "C:\PlikiExcela\" Tekst = "mój tekst" Plik = Dir(Sciezka & "\*.xls*") While Plik <> "" Call Wyszukaj(Sciezka & Plik, Tekst) Plik = Dir() Wend Set fso = CreateObject("Scripting.FileSystemObject... Set s = fso.GetFolder(Sciezka) For Each p In s.SubFolders...
Wydaje mi się, że bardziej chodzi o wybieranie wielu w oknie 'GetOpen'. Nie wnikając w "panel" i "remonty" powinno być coś takiego: [syntax=vbscript]Sub Wczytywaniedancyh() Dim otwieranie As String Dim tb() As Variant, test As Boolean, i As Integer Dim plik As String Dim kopiowanie As String Workbooks("Panel").Activate otwieranie = MsgBox("Wybierz plik",...
Przetestuj ten kod dla zdarzenia Worksheet_Change arkusza Form2. W komórce B4 arkusza Form2 wpisujesz jedynie numer rekordu do skopiowania. [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Dim lLstRw& 'pierwszy wolny wiersz w arkuszu "baaza" Dim lLstRwBs& 'ostatni zapisany wiersz w arkuszu "zbaza1" Dim lFndRec& 'numer wiersza ze znalezionym...
Przekaż Nr wiersza jako argument [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Cells.Count > 1 Then Exit Sub Set xRg = Intersect(Range("c5:c4000"), Target) If xRg Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value < 100 Then Call Mail_small_Text_Outlook(Target.Row) End If...
Kłopot pojawia sie wtedy gdy wyłącze już skoroszyt... to po 15 minutach włącza/otwiera się znowu mój skoroszyt. Jak tego uniknąć? Sub Autozapis() ActiveWorkbook.Save Application.OnTime Now() + TimeValue("00:15:00&quo... "Autozapis" End Sub Można tak: ZegarekStart z parametrem False i to zatrzymuje timer....
Trzeba dopisać do kodu jedną linijkę i zakończenie instrukcji warunkowej (bo już nie zmieści się w 1 linijce): [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub If Target = 2 Or Target = 3 Then Range("J" & Target.Row & ":AP" & Target.Row) = 0 Range("AQ" & Target.Row).Select...
Na moje wyczucie rzeczywiście są jakieś błędy w skrypcie, które wywołują Twój komunikat "1004". Ten wyszarzały przycisk references IMHO świadczy, że skrypt został z powodu błędu zatrzymany, a nie zakończony :D . Spróbuj kliknąć wtedy Run , niech dojdzie do końca i wtedy dopiero będziesz mógł uzupełnić ustawienie odpowiednich dla tego skryptu referencji....
Można to zrobić np. za pomocą VBA. Napisałem funkcję UDF, która tworzy listę (tablicę) nazw miejscowości odczytanych z zakresów wg podanego schematu. Wywołanie funkcji: [syntax=text]=List3D(schemat adresu)[/syntax] schemat adresu zawiera nazwę arkusza ze znakami zastępczymi w postaci akceptowanej przez operator Like w VBA, to znaczy w tym przypadku:...
1. Arkusz ma atrybut 'veryhidden' i przed usunięciem trzeba go zmienić. 2. W pliku jest nazwa do usunięcia. Najprościej [syntax=vb]Dim plik As Workbook Set plik = ThisWorkbook Application.DisplayAlerts = False On Error Resume Next With plik.Sheets("TemplateInformation") .Visible = True .Delete End With For Each nm In plik.Names nm.Delete Next Set plik...
1. Najprościej wyłączyć obsługę błędów For Each element in kolekcja . Np [syntax=vb]zakres = Array([a2], [c3], [d5]) For Each kom In zakres If kom = "" Then kom.Value = "-" Next[/syntax]
[syntax=vbscript]Sub ImportujPlikizWieluLokalizacji() Dim ZakresWejsciowy As String Application.ScreenUpdating = False Set p = Sheets("Parametry") Set i = Sheets("Import") For x = 2 To p.Cells(Rows.Count, "A").End(xlUp).Row If p.Cells(x, 5) = "x" Then Katalog = p.Cells(x, "A") If Right(Katalog, 1) <> "\" Then Katalog = Katalog & "\" On Error...
Cześć. Trochę miałem czasu więc napisałem coś takiego [syntax=vb]Sub kopiowanieDoArkuszy() Dim Naglowek As Range, Klient As Range Dim Nazwiska As New Collection Dim Element As Range Dim ws As Worksheet Dim Nazwa As String Set ws = Worksheets("arkusz1") ws.Select Set Klient = ws.Range(Range("a2"), Range("a2").End(xlDown)) On Error Resume Next For Each...
Kopiujesz arkusz (z formatami, filtrami, etc). A gdyby zastosować zwykłe kopiuj-wklej? Np [syntax=vb]Private Sub CommandButton1_Click() Dim wshSrc As Worksheet, wshDst As Worksheet Dim wbkSrc As Workbook, wbkDst As Workbook On Error GoTo Err_KopiujArkusz Set wbkSrc = ThisWorkbook 'ten skoroszyt Set wshSrc = wbkSrc.Worksheets("Arkusz1") wshSrc.Select...
[syntax=vbnet]Sub Bazy() On Error Resume Next Dim a As Worksheet, b As Worksheet Set a = Sheets("Baza danych A") Set b = Sheets("Baza danych B") a.Select owa = Cells(Rows.Count, "B").End(xlUp).Row owb = b.Cells(Rows.Count, "C").End(xlUp).Row For x = 5 To owa w = "" w = Application.Match(Cells(x, 2), b.Range("C5:C" & owb), 0) + 4 If w > 0 Then Cells(x,...
To przez to, że w kolumnie M masz funkcję WYSZUKAJ.PIONOWO która zwraca nieznalezione rekordy: #N/D! Albo upewnij się, że funkcja nie zwróci tych wartości, albo konwertuj zawartość komórki na string przed wczytaniem funkcją CStr() With Worksheets("BAAN 2") ost_wiersz = 97 For i = 8 To ost_wiersz Set listItem = ListView1.ListItems.Add(,...
A czy jest możliwość stworzenia makra, które po kliknięciu przycisku stworzy automatycznie arkusze dla wszystkich osób (i nada nazwy takie jak w pierwszej kolumnie tabeli tj. nazwisko i imię), a jeśli arkusz dla danych osób już istnieje, to je pominie. Można np tak: 968207
lesławek - tak się nie da. Sam spróbuj - ale skopiuj liczbę a nie komórkę. W załączeniu proste makro. Uruchomisz skrótem klawiszowym ctrl+m (można to zmienić) Makro odejmuje od komórki z lewej coś co jest w schowku i wprowadza to formułą w zaznaczonej komórce. [syntax=vb]Sub odejmij_schowek() Dim mem As DataObject On Error Resume Next Set mem = New...
excel runtime error excel makro syntax error error device error
transcend karta renault klimatyzacji elektrownia wodorowa
analizator widma np550p7c matryca
Schemat wtyczki modułu SAM Mercedes Sprinter 311 CDI Schemat pinów modułu SAM Mercedes Sprinter 2.2 CDI 2002
