VBA.Mania

Dziś jest piątek, 17 maja 2024 roku.

Powrót do serwisu

Regulamin

RSS

	tytuł wątku:
Wątki dyskusji	Pomoc w napisaniu makro otwarty rozpoczął: toczi1 postów: 64

napisał:

toczi1
postów: 75

umieszczony:
31 sierpnia 2016
11:40

edytowany:
31 sierpnia 2016
11:43

nazwa pliku	rozmiar
Baza_AZUP.xlsm	89.17 kB

Witam Trebor
Mam pytanie dało by się zrobić w przycisku DODAJ AZUP dodatkowe pole wyboru "Załącz plik" i jak klikniesz to możesz załączyć np: zdjęcia . I potem żeby wysłało ten plik w załączniku wiadomości email co jest napisany kod pod tym przyciskiem DODAJ AZUP.

Tak samo jak jest tu u góry "Wybierz plik"

Załączam plik gdzie tego bym potrzebował

napisał: toczi1 postów: 75 umieszczony: 29 sierpnia 2016 20:32
	Cytat: Co ten warunek ma robić? If ListBox1.Selected(i) Then End If On tylko jest i nic z niego nie wynika. Już sobie poradziłem. Coraz więcej się uczę hehe a to dzięki tobie To ten warunek najwyżej usunę Pozdrawiam

napisał: Trebor postów: 1209 umieszczony: 29 sierpnia 2016 18:25
	Co ten warunek ma robić? If ListBox1.Selected(i) Then End If On tylko jest i nic z niego nie wynika.

napisał:

toczi1
postów: 75

umieszczony:
29 sierpnia 2016
14:42

nazwa pliku	rozmiar
Baza_AN_1.xlsm	109.74 kB

Witam potrzebuje pomocy w tym aby jeśli mam w list boxie teskt "W45" to żeby wysyłało email do np osoby 1 i 2 a jeśli będę miał "W56" to np żeby wysyłało do osoby 1 i osoby 3 . Chodzi tu o przycisk "Dodaj opinie"
Zrobiłem coś takiego i wywala błąd na "Next i"

Private Sub CommandButton2_Click()
Dim i As Long, ostatni As Long

If ListBox1.ListCount = -1 Then MsgBox "Brak listy materiałów.": Exit Sub

For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) Then

End If

If ListBox1.List(i, 3) = "Zamknięte" Then: Exit Sub

If ListBox1.List(i, 4) = "W56" Then

Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 3) = "W toku"
Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 21) = Application.UserName & " " & Format(Date, "dd.mm.yyyy")
Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 15) = Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 15) & Chr(10) & InputBox("Dodaj Opinie")

ActiveWorkbook.FollowHyperlink "mailto:" & "osoba 3;osoba 1" & ";" & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 13) & ";" & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 10) & "?subject=Zgłoszenie AN " & "&" & "body=" & "Dodano Opinie - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 2) & _
"%0a Osoba opiniująca - " & Application.UserName & _
"%0a Numer detalu - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 4) & _
"%0a Wydanie rysunku - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 5) & _
"%0a Numer Operacji - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 6) & _
"%0a Numer Serii - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 7) & _
"%0a Ilość sztuk w serii/sztuki niezgodne - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 8) & _
"%0a" & _
"%0a Prosze o zapoznanie sie z opinią i proszę o podanie decyzji Wydziałowej KJ " & _
"%0a Opinia osoby odpowiedzialnej za AN: " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 15) & _
"%0a Status AN - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 3) & _
"%0a Link do pliku AN: file:\\P:\W50_KJ50_CMM\Baza_AN\Baza_AN.xlsm "

Application.Wait (Now + TimeValue("0:00:16"))
Application.SendKeys "^~" 'skrót klawiaturowy w Twoim programie pocztowym

zerowanie
ThisWorkbook.Save
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close

End If

If Not ListBox1.List(i, 4) = "W56" Then

If ListBox1.List(i, 4) = "W45" Then

Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 3) = "W toku"
Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 21) = Application.UserName & " " & Format(Date, "dd.mm.yyyy")
Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 15) = Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 15) & Chr(10) & InputBox("Dodaj Opinie")

ActiveWorkbook.FollowHyperlink "mailto:" & "osoba 1;Osoba 2" & ";" & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 13) & ";" & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 10) & "?subject=Zgłoszenie AN " & "&" & "body=" & "Dodano Opinie - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 2) & _
"%0a Osoba opiniująca - " & Application.UserName & _
"%0a Numer detalu - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 4) & _
"%0a Wydanie rysunku - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 5) & _
"%0a Numer Operacji - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 6) & _
"%0a Numer Serii - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 7) & _
"%0a Ilość sztuk w serii/sztuki niezgodne - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 8) & _
"%0a" & _
"%0a Prosze o zapoznanie sie z opinią i proszę o podanie decyzji Wydziałowej KJ " & _
"%0a Opinia osoby odpowiedzialnej za AN: " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 15) & _
"%0a Status AN - " & Sheets("Baza_AN").Cells(ListBox1.List(i, 2), 3) & _
"%0a Link do pliku AN: file:\\P:\W50_KJ50_CMM\Baza_AN\Baza_AN.xlsm "

Application.Wait (Now + TimeValue("0:00:15"))
Application.SendKeys "^~" 'skrót klawiaturowy w Twoim programie pocztowym

zerowanie
ThisWorkbook.Save
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close

End If

If Not ListBox1.List(i, 4) = "W45" Then: Exit Sub

End If
Next i
Unload Me
End Sub

napisał: toczi1 postów: 75 umieszczony: 22 sierpnia 2016 13:27
	Cytat: Sprawdź poniższą procedurę maks = Application.Max(Sheets("BAZA_AZUP").Columns(1)) If Mid(maks, 1, 4) = CStr(Year(Date)) Then TextBox1.Text = maks + 1 Else TextBox1.Text = Year(Date) & Format(1, "000") TextBox2.Text = "AZUP/" & Mid(TextBox1.Text, 1, 4) & "/" & Mid(TextBox1.Text, 5, 10) Zakładam, że obsługujący nie będzie bawił się w zmiany daty w komputerze w ten sposób, że np. w roku 2017 wprowadzi dane a następnie zmieni datę na rok 2016. Wtedy numerowanie rozpocznie się od 2016001, pomimo że w 2016 były już wpisy. Działa wszystko ok . A wprowadzający nie zmieni daty bo to tylko może zrobić administrator komputerów czyli IT.

napisał: Trebor postów: 1209 umieszczony: 17 sierpnia 2016 07:28
	Sprawdź poniższą procedurę maks = Application.Max(Sheets("BAZA_AZUP").Columns(1)) If Mid(maks, 1, 4) = CStr(Year(Date)) Then TextBox1.Text = maks + 1 Else TextBox1.Text = Year(Date) & Format(1, "000") TextBox2.Text = "AZUP/" & Mid(TextBox1.Text, 1, 4) & "/" & Mid(TextBox1.Text, 5, 10) Zakładam, że obsługujący nie będzie bawił się w zmiany daty w komputerze w ten sposób, że np. w roku 2017 wprowadzi dane a następnie zmieni datę na rok 2016. Wtedy numerowanie rozpocznie się od 2016001, pomimo że w 2016 były już wpisy.

napisał: toczi1 postów: 75 umieszczony: 16 sierpnia 2016 22:01
	Cytat: Czy można wykorzystać kolumnę LP, oraz ile maksymalnie rocznie przewidujesz wpisów? W LP można by stosować zapisy: 201600001 201600002 .............. 201700001 co umożliwi wykorzystanie w dalszym ciągu funkcji Max. Na pewno więcej niż 500 nie będzie. Ale jak wskoczy nowy rok i dam z reki w LP 1 to bedzie dalej numerowalo 2,3,4 i wtedy będzie ok

napisał: Trebor postów: 1209 umieszczony: 16 sierpnia 2016 21:38
	Czy można wykorzystać kolumnę LP, oraz ile maksymalnie rocznie przewidujesz wpisów? W LP można by stosować zapisy: 201600001 201600002 .............. 201700001 co umożliwi wykorzystanie w dalszym ciągu funkcji Max.

napisał: toczi1 postów: 75 umieszczony: 16 sierpnia 2016 10:15
	Takie pytanie co tu wstawić ze jeśli pojawi się nowy rok np. 2017 to żeby znowu numerowało od 1 TextBox2.Text = "AN/" & Year(Date) & "/" & Format(Application.Max(Sheets("BAZA_AN").Columns(1)) + 1, "000")

napisał: toczi1 postów: 75 umieszczony: 10 sierpnia 2016 17:48
	Wszystko działa ok nawet z zegarkami pomogło to zerowanie zamyka i już nie otwiera. Dziękować

napisał: toczi1 postów: 75 umieszczony: 10 sierpnia 2016 16:30
	Cytat: Spróbuj przed zapisaniem i zamknięciem skoroszytu dopisać wiersz "zerowanie". Tak jak procedura w module standardowym. Application.SendKeys "^~" 'skrót klawiaturowy w Twoim programie pocztowym zerowanie ThisWorkbook.Save If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close Pomogło potem potestuje lepiej i napisze jak i co

napisał: Trebor postów: 1209 umieszczony: 10 sierpnia 2016 16:07
	Spróbuj przed zapisaniem i zamknięciem skoroszytu dopisać wiersz "zerowanie". Tak jak procedura w module standardowym. Application.SendKeys "^~" 'skrót klawiaturowy w Twoim programie pocztowym zerowanie ThisWorkbook.Save If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close

napisał: toczi1 postów: 75 umieszczony: 10 sierpnia 2016 15:56 edytowany: 10 sierpnia 2016 16:27
	Cytat: Oczywiście, że możesz pozmieniać nazwy. Daj znać czy to pomogło. Pozmieniałem i w twój skoroszyt i w moduł i nic, dalej zamyka i otwiera go ponownie. Zrób kopie tego pliku co wysłałeś poniżej i dodaj AZUP i sam zobaczysz ze go otwiera ponownie. Tylko jak masz otwarty zwykły excel to wtedy go nie otwiera dzieje się to jeżli są 2 excele z makrami.

napisał: Trebor postów: 1209 umieszczony: 10 sierpnia 2016 13:39
	Oczywiście, że możesz pozmieniać nazwy. Daj znać czy to pomogło.

napisał: toczi1 postów: 75 umieszczony: 10 sierpnia 2016 09:12 edytowany: 10 sierpnia 2016 09:27
	Cytat: Sprawdź teraz. Nie wszystkie polecenia zamknięcia zamieniłeś na nową procedurkę. Co do otwierania to dopisałem linię w Sub Zegar Dalej się otwiera po zamknięciu jeśli są 2 pliki otwarte. Nie wiem czy to nie kwestia tego ze mam 2 pliki z makrami i są tam te same zegarki odliczające czas do zamknięcia. Sprawdzałem dzieje się to tylko kiedy mam pliki z makrami bo jak otworzyłem zwykłego excela to tak się nie dziej normalnie zamyka i tyle. A moge np te zmienne tutaj Application.OnTime EarliestTime:=czas, Procedure:="Zegar", Schedule:=False pozmieniac np czas na czasy , zegar na zegarek i analigicznue wszedzie gdzie te zmienne wystepuha na tak samo. Czy to nie bedzie działac ? Chodzi mi o to zeby sie nie kłocilo w 2 plikach ze jest to samo i dlatego moze otwiera go spowrotem. Nawet jesli zrobisz kopie z rej kopi co wyslales to rak robi

napisał: Trebor
postów: 1209

umieszczony:
10 sierpnia 2016
08:34

nazwa pliku	rozmiar
Kopia Baza_AZUP-1.xlsm	84.81 kB

Sprawdź teraz.
Nie wszystkie polecenia zamknięcia zamieniłeś na nową procedurkę.
Co do otwierania to dopisałem linię w Sub Zegar

napisał:

toczi1
postów: 75

umieszczony:
9 sierpnia 2016
20:22

edytowany:
9 sierpnia 2016
20:26

nazwa pliku	rozmiar
Baza_AZUP.xlsm	84.73 kB

Trebor
Mógłbyś mi zmienić z tym czasem w tym pliku aby było możliwe zamykanie ThisWorkBook.Close i żeby go zaraz nie otwierało ponownie bo nie chce używac Application.Quit bo mi zamyka inne pliki excel. I napisz gdzie był błąd
Bo z reszta już sobie poradziłem

napisał: toczi1 postów: 75 umieszczony: 9 sierpnia 2016 17:02 edytowany: 9 sierpnia 2016 17:12
	Cytat: Witaj Zamykanie skoroszytu i aplikacji Sub zamykanie() ThisWorkbook.Save If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close End Sub Otwierający się skoroszyt Jeśli to dotyczy skoroszytu nad którym pracowałeś na forum to na 99,99% dotyczy to niewłaściwego usuwania zaplanowanego zadania: Application.OnTime EarliestTime:=czas, Procedure:="Zegar", Schedule:=False Jeśli podasz niewłaściwy czas w powyższej linii to zadanie nie zostanie anulowane i skoroszyt się otworzy o zaplanowanej godzinie. Obsługa błędu powinna służyć tylko do pominięcia błędu, gdy żadne zadanie nie jest zaplanowane. Możesz sprawdzić co kryje się pod zmienną Czas. Jeśli to data z przyszłości musisz zadanie anulować. Jeśli z przeszłości możesz się tym nie przejmować. Otwieranie skoroszytu Zapis wygląda poprawnie, chociaż nie wiadomo co kryje się pod ścieżką. Nie zapomnij też o ukośniku. Workbooks.Open ThisWorkbook.Path & "\Zeszyt11.xlsm" Zamykanie mam wstawic do modul czy w odpowiedniego userform? Czy mam to podstawic zamiast ThisWorkBook.Save Application.Quit Tak dotyczy to skoroszytu nad ktorym pracowałem. Tylko on zaraz sie otwiera po jego zamknieciu. A to otwieraniu pliku to do userform dac pod userform click Mógłbyś sprawdzić czy w tym pliku z postów ponizej jest wszystko ok z tym Application.OnTime EarliestTime:=czas, Procedure:="Zegar", Schedule:=False bo kiedyś coś tam wycinane bo wyrzucalo błąd tylko nie pamiętam czy w moduł czy twój skoroszyt to zmieniałem

napisał: Trebor postów: 1209 umieszczony: 9 sierpnia 2016 16:22 edytowany: 9 sierpnia 2016 16:22
	Witaj Zamykanie skoroszytu i aplikacji Sub zamykanie() ThisWorkbook.Save If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close End Sub Otwierający się skoroszyt Jeśli to dotyczy skoroszytu nad którym pracowałeś na forum to na 99,99% dotyczy to niewłaściwego usuwania zaplanowanego zadania: Application.OnTime EarliestTime:=czas, Procedure:="Zegar", Schedule:=False Jeśli podasz niewłaściwy czas w powyższej linii to zadanie nie zostanie anulowane i skoroszyt się otworzy o zaplanowanej godzinie. Obsługa błędu powinna służyć tylko do pominięcia błędu, gdy żadne zadanie nie jest zaplanowane. Możesz sprawdzić co kryje się pod zmienną Czas. Jeśli to data z przyszłości musisz zadanie anulować. Jeśli z przeszłości możesz się tym nie przejmować. Otwieranie skoroszytu Zapis wygląda poprawnie, chociaż nie wiadomo co kryje się pod ścieżką. Nie zapomnij też o ukośniku. Workbooks.Open ThisWorkbook.Path & "\Zeszyt11.xlsm"

napisał: toczi1 postów: 75 umieszczony: 9 sierpnia 2016 10:53
	Witam Trebor ThisWorkBook.Save Application.Quit mama taki kod i on zapisuje i zamyka excel tylko jak mam otwarty inny plik excek to tez go zamyka. ThisWorkBook.Save ThisWorkBook.Close zastosowałem taki kod ale wtedy gdy zamyka ten skoroszyt to automatycznie go zaraz otwiera samo nie wiem czemu. Co by zastosować żeby zapisywało i zamykało tylko ten skoroszyt co go używam. Activeworkbook.close tez próbowałem i jest to samo zaraz go otwiera. Jak podpiąć pod przycisk link żeby otwierało inny plik : Workbooks.Open(scieżka & "plik_1.xlsm") --- takie coś będzie jak wstawię do userform ?

wstecz 1 2 3 4 dalej

wszystkich stron: 4