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: 63773 Skopiuj do schowka Warunki do operacji na pliku
Autor Wiadomość
Boruciak
Starszy Forumowicz


Posty: 57
Wysłany: 11-01-2019, 10:54   Warunki do operacji na pliku

Cześć,
Makro robi:
Klikam na przycisk, wybieram plik. Makro kopiuje plik do lokalizacji wskazanej zmienną sciezka.
Następnie w komórce D1 pojawia się pełna nazwa pliku.
Wypociłem taki kod:
Kod:

Sub Przycisk2_Click()

Dim numerwiersza As Integer
Dim nazwadoc2 As String
Dim nazwadoc3 As Variant
Dim sciezka As String
EnableEvents = True

nazwadoc3 = Application.GetOpenFilename(filefilter:="Załącznik (*.pdf; *.jpg; *.msg; *.xls*; *.doc*),*.pdf; *.jpg; *.msg; *.xls*; *.doc*; *.zip", MultiSelect:=False)

If nazwadoc3 = False Then
    MsgBox "Nie wybrano odpowiedniego pliku z pismem. Wybrane mogą być tylko pisma w formatach: pdf, jpg, msg, xls*, doc*, zip!", vbExclamation, "Uwaga!"
Else
 '   MsgBox "Plik wybrano.", vbExclamation, "OK"
End If

nazwadoc = nazwadoc3

nazwadoc2 = Mid(nazwadoc, InStrRev(nazwadoc, "\", Len(nazwadoc)) + 1, Len(nazwadoc))
MsgBox Mid(nazwadoc2, 1, InStr(nazwadoc2, ".") - 1)

    Range("D1").Select
    ActiveCell.FormulaR1C1 = nazwadoc2

sciezka = "C:\TMP"

FileCopy nazwaskanu, sciezka & "\pisma\" & nazwaskanu2

End Sub

Potrzebuję aby makro robiło dodatkowo:
1. Przed kliknięciem w przycisk, w komórce F1 wpisuję PRZYCHODZACY/WYCHODZACY. Jeżeli tego nie wpiszę a kliknę na przycisk ma być komunikat o niewypełnieniu wszystkich pól i przerwanie makra.
2. Plik ma kopiować się do podfolderu PRZYCHODZACY/WYCHODZACY w zależności od wpisu w komórce.
3. Jeżeli plik istniej, pytanko czy zastąpić.
4. Zmienić nazwę pliku dorzucając na początku tekst z komórki C1.

Dodatkowa prośba o prostą modyfikację kodu – bez skrótów programowych – żebym nie przepalił zwojów analizując kodzik :)
Z góry dziękuję Excelowym maniakom za pomoc.
ID posta: 360223 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Pomógł: 231 razy
Posty: 1235
Wysłany: 11-01-2019, 14:57   

Cytat:
Dodatkowa prośba o prostą modyfikację kodu
Proszsz...:
Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim nazwadoc As String, sciezka As String

nazwadoc = Application.GetOpenFilename(filefilter:="Załącznik (*.pdf; *.jpg; *.msg; *.xls*; *.doc*;*.png),*.pdf; *.jpg; *.msg; *.xls*; *.doc*; *.zip;*.png", MultiSelect:=False)

If nazwadoc = False Then
    MsgBox "Nie wybrano odpowiedniego pliku z pismem. Wybrane mogą być tylko pisma w formatach: pdf, jpg, msg, xls*, doc*, zip!, png", vbExclamation, "Uwaga!"
    Exit Sub
End If

Range("D1").Value = nazwadoc

sciezka = "C:\TMP\"
nazwadoc = Mid(nazwadoc, InStrRev(nazwadoc, "\", Len(nazwadoc)) + 1, Len(nazwadoc))
FileCopy nazwadoc, sciezka & nazwadoc

End Sub

FYI: Dorzuciłem format .png.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
I dbajmy - proszę - o poprawną polszczyznę.
  
ID posta: 360238 Skopiuj do schowka
 
 
Tajan


Pomógł: 4243 razy
Posty: 9445
Wysłany: 11-01-2019, 15:35   

Boruciak napisał/a:
Plik ma kopiować się do podfolderu PRZYCHODZACY/WYCHODZACY
A jaki ma być folder nadrzędny? "C:\TMP"? "C:\TMP\pisma"? Inny?
ID posta: 360242 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Pomógł: 2026 razy
Posty: 6726
Wysłany: 11-01-2019, 16:21   

Tak to zrozumiałem:
Kod:
Sub Klik()
    Dim Path        As String
    Dim FName       As String
    Dim FPath       As String

    If Range("F1").Value = "PRZYCHODZACY" Or Range("F1").Value = "WYCHODZACY" Then

        FPath = Application.GetOpenFilename(filefilter:="Załącznik (*.pdf; *.jpg; *.msg; *.xls*; *.doc*;*.png),*.pdf; *.jpg; *.msg; *.xls*; *.doc*; *.zip;*.png", MultiSelect:=False)

        If FPath = "False" Then Exit Sub
        Path = "C:\TMP\" & Range("F1").Value & "\"

        FName = Range("C1").Value & Mid(FPath, InStrRev(FPath, "\", Len(FPath)) + 1, Len(FPath))

        If FileFolderExists(Path & FName) Then
            If MsgBox("Plik istnieje - czy chcesz go nadpisać ?", vbYesNo + vbInformation) = 7 Then Exit Sub
        End If

        FileCopy FPath, Path & FName
    Else
        MsgBox "Uzupełnij komórkę F1", vbInformation
    End If

End Sub

Public Function FileFolderExists(MyFullPath As String) As Boolean
    On Error Resume Next
    FileFolderExists = Not Dir(MyFullPath, vbDirectory) = vbNullString
    On Error GoTo 0
End Function
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 360247 Skopiuj do schowka
 
 
Boruciak
Starszy Forumowicz


Posty: 57
Wysłany: 12-01-2019, 14:34   

Ożeszsz....

Wybaczcie, że nie wyraziłem się ściśle. Chciałem uzyskać pomoc dotyczącą mechaniki operacji na pliku z warunkami za co dziękuję.
Postudiowałem i poskładałem w całość - działa tak jak sobie to wymyśliłem.
Dziękuję Wam.
ID posta: 360291 Skopiuj do schowka
 
 
Boruciak
Starszy Forumowicz


Posty: 57
Wysłany: 12-01-2019, 15:02   

Dorzucając do tematu związanego z moimi wypocinami...
W czym problem....

Wybieram plik makrem jak wyżej - wszystko ok.

Dorzuciłem:
Kod:

        Range("D1").Select
        ActiveCell.FormulaR1C1 = FName

czyli w komórce D1 pojawia mi się nazwa pliku - wszystko ok

W E1 wklepałem formułę:
Kod:

=JEŻELI(CZY.PUSTA(D1);"";JEŻELI(PLIKISTNIEJE("C:\PISMA\"&G1&"\"&D1);"OK";"BRAK"))

czyli potwierdziam istniejący plik - jest ok ale muszę ręcznie odświeżać komórkę.

Zastosowałem
Kod:

Columns("E:E").Calculate

oraz inne gadżety wygrzebane na forum - dodając na końcu makra ale nie działa.

Cała kolumna E będzie odnosić się do wartości w kolumnach D i chciałbym aby po dodaniu pliku przeliczał mi formułę sprawdzającą plik.
Sama formuła wskazuje prawidłowo jak ją edytuję (F2) i zapiszę (Enterek).
Oczywiście w opcjach Excela mam włączone automatycznie obliczanie formuł.
ID posta: 360293 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Pomógł: 2026 razy
Posty: 6726
Wysłany: 12-01-2019, 15:17   

Zamień:
Kod:
        Range("D1").Select
        ActiveCell.FormulaR1C1 = FName
na
Kod:
Range("D1").Value = FName

A masz taką funkcję PLIKISTNIEJE ?
Ja mam o nazwie FileFolderExists, więc powinno być:
Kod:
=JEŻELI(CZY.PUSTA(D1);"";JEŻELI(FileFolderExists("C:\PISMA\"&G1&"\"&D1);"OK";"BRAK"))
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
  
ID posta: 360294 Skopiuj do schowka
 
 
Boruciak
Starszy Forumowicz


Posty: 57
Wysłany: 12-01-2019, 15:32   

Zmieniłem.
Mam w Excelu PlikIstnieje. MS Office Standard 2016
Mimo wszystko zmieniłem na angielski odpowiednik.

Pomogło umieszczając
Kod:

Range("D1").Value = FName

poza warunkiem IF
Dzięki
ID posta: 360296 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Pomógł: 2026 razy
Posty: 6726
Wysłany: 12-01-2019, 15:36   

Pokaż załącznik , co Ty tam masz?
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 360297 Skopiuj do schowka
 
 
Boruciak
Starszy Forumowicz


Posty: 57
Wysłany: 12-01-2019, 16:03   

Jest i załącznik.
Ponieważ Skoroszyt to straszny kombajn, wrzuciłem w załącznik tylko to co dotyczy tego zagadnienia. Sorry za chaos ale jeszcze tego nie ułożyłem.

Cała istota ma polegać na wrzuceniu do pierwszego wiersza pliku za pomocą makra. Po potwierdzeniu cały wiersz zostanie skopiowany na koniec tabeli.
Kolumna E ma sprawdzać czy plik w kolumnie D znajduje się w katalogu.
Dodatkowo wrzucę formułę na zasadzie HIPERŁĄCZE(..), która pozwoli mi otworzyć plik.

testy.xlsm
Pobierz Plik ściągnięto 3 raz(y) 30.07 KB

ID posta: 360299 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