Forum IDG.pl - miejsce dyskusji o IT: seryjny import jpg do excela - Forum IDG.pl - miejsce dyskusji o IT

Witam,
szukalem juz od kilku dni na forum (pomimo iz jestem zarejestrowany tylko od dzis), niestety nie znalazlem (mam nadzieje ze to nie slepota )

oto pacjent

w skoroszycie1 w kolumnie od B2 do B..... sa numery ref ktorym odpowiada zdjecie jpg
np: ref = 123456 ; zdjecie = 123456.jpg
nr ref sa zmienne, ale zawsze 6 cyfr w zakresie od 001000 do 999999
lekarstwo potrzebne
funkcja ktora by dodala zdjecia w kolumne A tak aby ref i odpowiednie zdjecie bylo w tym samym wierszu
wymiar zdjec nie musi byc duzy*
aby zdjecia sie ustawialy centralnie w komorce
dobrze by bylo gdyby wysokosc wiersza sie ustawiala automatycznie (jak sie nie da to recznie zajmie to chwile)

Dzieki za wszelkie sugestie i pomoc

Edit: nie napisalem ze chodzi o Office 2003
zbior zdjec moze byc zawarty w tym samym folderze co excel, lub w samym excelu
*jesli jest taka potrzeba zdjecia moge zwymiarowac odpowiednio do funkcji
+
podczas wklejania/dopisywania/wstawiania nowego wiersza aby dodawalo zdjecie
podczas sortowania wg ref aby zdjecia i cala reszta przemieszczala sie logicznie
jesli brakuje zdjecia to niech wstawia "noimage.jpg"

Czy możesz napisać do czego ma służyć ten skoroszyt ze zdjęciami wstawianymi w komórkach?
Do czego to będziesz wykorzystywał?

Może wystarczy coś w rodzaju przeglądarki zdjęć w Excelu, np. po to, aby obejrzeć wygląd produktu?
Przeszukaj forum na hasło "przeglądarka", a znajdziesz przynajmniej jeden wątek, w którym odpowiadałam komuś i zrobiłam taką przeglądarkę w UserFormie Excela. Można to przerobić na przeglądanie zdjęć we wstawionym w arkuszu obiekcie Image, gdzie ładowany byłby inny obraz po każdym kliknięciu na kolejnej komórce (robiłam już coś takiego, obraz przesuwał się jeszcze zgodnie z przewijaniem ekranu).

Koziorozec
dzieki za zaintersowanie i wskazowki "przegladarka" juz sie zabieram za szukanie i testy

generalnie moja potrzeba to cennik na ok 1500 - 2000 produktow full wersja ze zdjeciami, pelnym opisem produktu, wszelkimi danymiu logistycznymi itp

pojde narazie twoim tropem i dam znac czy OK

pozdr

Koziorozec,
moglabys podrzucic zalacznik aby zobaczyc jak sie prezentuje

Koziorozec powiedział:

Czy chodzi Ci o mój załącznik do tamtego rozwiązania? Na forum był mój załącznik - poszukaj.

jesli masz na mysli ten temat http://forum.idg.pl/pakiety_biurowe-f118-p...ec-t131404.html
to tak znalazlem, ale nie bardzo moge roszyfrowac jak mialbym to zastosowac u siebie
w twojej przegladarce po kliknieciu widac okno a w nim fotki do wyboru
ja potrzebowal bym aby dla zawartosci komorek w kolumnie np A po kliknieciu w dana komorke wyswietlalo sie zdjecie produktu oraz tak jak nadmienilas aby obraz przesuwal sie razem z przewijaniem ekranu

Wydaje mi się, że gdzieś umieszczałam tą drugą swoją przeglądarkę, ale nie chce mi się szukać.
W załączniku jest plik z taką przeglądarką, o jaką Ci (tak myślę) chodziło.

Uwaga! Plik .zip ma 2 MB, bo są tam spakowane, odpowiednio nazwane obrazy .jpg.

http://www.wrzucaj.com/609761

To jest genialne , a juz na pewno autorka
jednak w moim przypadku caly "ekran" excela bedzie zajety danymi i przesloniecie ich oknem "image" nie bedzie sie dobrze prezentowac moim zdaniem.

Mimo wszystko dzieki za podpowiedz

zastanawiam sie jeszcze nad opcja "pojawiam sie i znikam" czyli zdjecie pojawia sie po 1 kliku a po 2 kliku znika, widzialem to gdzies na tym forum

Edit:
znalazlem http://forum.idg.pl/...php/t16092.html
ale jakos nie moge dojsc do ladu, podmieniam kolumne B na E i otrzymuje "compile error, syntax error"
mam zdjecia w tym samym folderze co excel, wskazalem sciezke w A1 do tegoz folderu
szukac ma po kolumnie E ktorej zawartosc odpowiada nazwom .jpg
Maly_Rycho podpowiedz prosze

MadMax, o 03-12-2009, 11:28, powiedział:

Dzięki. Sama byłam zadowolona z tego małego dziełka

Cytuj

Może spróbuj nowej wersji. Przerobiłam to tak, że kolumna B zawiera symbol strzałki, a kliknięcie na jakiejś komórce w tej kolumnie powoduje wyświetlenie obrazu w obiekcie Image oraz pokolorowanie tej komórki (aby było wiadomo, który towar aktualnie oglądamy - można by to zrobić, np. dla całego wiersza, w którym kliknięta jest komórka, nawet w którejkolwiek kolumnie).
Dodatkowo, wcześniej skoroszyt był zapisywany z ostatnim obrazem załadowanym do obiektu Image, co powodowało, że jego rozmiar rósł do kilku MB - zupełnie niepotrzebnie, więc dodałam pozorne wyładowywanie obrazu przez zapisem i zamknięciem pliku.
Z tego względu, że są tam te dodatkowe funkcje, to trzeba to gruntownie przetestować - ewentualne błędy wyjdą podczas używania.

Uwaga! Wrzuciłam tylko sam plik Excela, ale do działania są potrzebne pliki graficzne z załącznika do poprzedniego postu!

http://www.wrzucaj.com/877674

koziorozec powiedział:

brak mi slow aby wyrazic moj podziw i szacunek dla tego co stworzylas , polaczylas swoja przegladarke z moim "widzimisie"
BRAWO , DZIEKUJE

koziorozec powiedział:

dla mnie nie ma takiej potrzeby, a nawet byloby to uciazliwe, poniewaz ja jak rowniez i klienci wiele razy klikaja w rozne komorki kopiujac rozne elementy z cennika

koziorozec powiedział:

super ulepszenie aby rozmiar sie nie powiekszal po kazdym otwarciu/zapisie
testuje i jak na razie nic sie nie wydarzylo

Goraca prosba
potrzebuje aby kolumna A (i tylko A) byla ukryta i zabezpieczona przed modyfikacjami haslem, co mam dopisac w kodzie ?

MadMax, o 04-12-2009, 14:09, powiedział:

Do tego właściwie nie potrzeba kodu VBA.
Ale czy ja dobrze rozumiem, że chcesz ukryć kolumnę A? W moim pliku tam są nazwy towarów, mam nadzieję, że u Ciebie jest inaczej.
W tej wersji przeglądarki możnaby zrobić i tak, że te strzałki do wywoływania obrazu - podglądu byłyby w pierwszej kolumnie, czyli np. z lewej strony od kolumny z nazwami. Jeśli takie rozwiązanie Ci potrzebne, to trochę trzeba by przerobić kod.

Co do ukrywania - zaznacz kolumnę A i prawym przyciskiem myszy wywołaj menu, a z niego wybierz Ukryj.
Potem trzeba zabezpieczyć arkusz: menu Narzędzia-->Ochrona-->Chroń arkusz. Musisz tam wybrać, na co pozwolisz użytkownikom (przyjrzyj się dokładnie), potem wpisać hasło i masz zabezpieczenie przed odkrywaniem kolumny.

czy mozna przesunac w prawo / lewo okno image?

MadMax, o 05-12-2009, 9:36, powiedział:

Jaśniej proszę. Czy chodzi o przesunięcie obiektu na stałe? Jeśli tak, to musisz włączyć pasek narzędzi Przybornik formantów i włączyć na czas edycji przycisk z ekierką. Wtedy zaznaczyć obiekt i przesunąć, a potem znowu wyłączyć przycisk z ekierką i zamknąć pasek.

DZIEKUJE
dokladnie o to mi chodzilo

Czym sie posluzyc aby sprawdzic liste ref z excela ze zdjeciami w katalogu
mam 1200 ref w excelu i 4970 jpg w katalogu, jest jaks metoda aby porownac ktorych jpg mi brakuje a ktore moge usunac ?

Proponuje oznaczyć kolorem niebieskim znalezione w kolumnie "A"
nazwy plików fotek z listą nazw plików folderu "Foty" w kolumnie "D".

Private Sub CommandButton1_Click()
'importujemy listę nazw plików z folderu Foty do kolumny D
 folder = ThisWorkbook.Path & "\Foty\"
  
 Dim mrange
  Dim w, v

    f = Dir(folder, vbDirectory)

    Set mrange = Range("D1")
    mrange.Value = f

    Do While f <> ""
    f = Dir
        If f <> "" Then
            Set mrange = mrange.Offset(1, 0)
            mrange.Value = f
        End If
    Loop
    'sprawdzamy długość kolumny A
    With ActiveSheet.Range("A:A")
Set s = .Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)
End With
w = s.Row
    'sprawdzamy długość kolumny D
    With ActiveSheet.Range("D:D")
Set s = .Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)
End With
v = s.Row
MsgBox w & " " & v
 wierszKolumnyA = 1
  
'pętla wykonywana dopóki nie dojdziemy do końca kolumny A
Do While w > wierszKolumnyA
wierszKolumnyD = 1
      'pętla porównania kolumny A z D
    Do While v > wierszKolumnyD
     
If Range("A" & wierszKolumnyA) = Range("D" & wierszKolumnyD) Then
'oznaczamy znalezione duplikaty
Range("A" & wierszKolumnyA).Font.ColorIndex = 5
End If
MsgBox wierszKolumnyA & " " & wierszKolumnyD
wierszKolumnyD = wierszKolumnyD + 1
Loop
'nastepny wiersz
 wierszKolumnyA = wierszKolumnyA + 1
Loop

End Sub

Nie rozumiem drugiego warunku " a które mogę usunąć ".
Usunąć z folderu czy z listy?
Pozdrawiam

Dodano 11-12-2009 20:48:17:

Sorry zapomniałem usunąć Msgbox-y z kodu proszę poprawić.

chodzi o usuniecie zbednych jpg z folderu

poniewaz VBA to czarna magia dla mnie prosze o kilka wskazowek

Cytuj

czy mam usunac te fragmenty ? czy cos wiecej

Cytuj

poza tym cos wiecej mam zrobic , czy tez po wklejeniu w view code automatycznie sie odznacza ref na niebiesko ?

Cześć

Poprawiłem kod, aby po otwarciu arkusza został wykonany i oznaczył na niebiesko ref w kolumnie B
(wcześniej błędnie była to A)
Kod musisz wkleić do okna "view code" w tym arkuszu z ref - w założeniu przyjąłem, iż kolumna D jest u ciebie
wolna i można ją wykorzystać do porównania zawartości folderu .
Co do "chodzi o usuniecie zbędnych jpg z folderu”, iż"masz 1200 ref w Excelu i 4970 jpg w katalogu "
to dobrze było by wiedzieć, jakie nazwy mają zdublowane fotki np.111111(1).jpg,111111(2).jpg
czy mogą też być nazwane różnie np.111111.jpg ,111112.jpg
Czy chcesz to wykonać ręcznie czy wykorzystać makro?( tu trzeba trochę ostrożnie postępować, więc dane muszą być prawidłowe i pewne)

Private Sub Worksheet_Activate()
'importujemy listę nazw plików z folderu Foty do kolumny D
 folder = ThisWorkbook.Path & "\Foty\"
  
 Dim mrange
  Dim w, v

    f = Dir(folder, vbDirectory)

    Set mrange = Range("D1")
    mrange.Value = f

    Do While f <> ""
    f = Dir
        If f <> "" Then
            Set mrange = mrange.Offset(1, 0)
            mrange.Value = f
        End If
    Loop
    'sprawdzamy długość kolumny B
    With ActiveSheet.Range("B:B")
Set s = .Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)
End With
w = s.Row + 1
    'sprawdzamy długość kolumny D
    With ActiveSheet.Range("D:D")
Set s = .Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)
End With
v = s.Row + 1

 wierszKolumnyB = 1
  
'pętla wykonywana dopóki nie dojdziemy do końca kolumny B
Do While w > wierszKolumnyB
wierszKolumnyD = 1
      'pętla porównania kolumny B z D
    Do While v > wierszKolumnyD
     
If Range("B" & wierszKolumnyB) & ".jpg" = Range("D" & wierszKolumnyD) Then
'oznaczamy znalezione duplikaty
Range("B" & wierszKolumnyB).Font.ColorIndex = 5
'ten kod usunie zduplikowane pliki
End If

wierszKolumnyD = wierszKolumnyD + 1
Loop
'nastepny wiersz
 wierszKolumnyB = wierszKolumnyB + 1
Loop

End Sub

Pozdrawiam

tsaslade, o 12-12-2009, 18:25, powiedział:

Nie analizuję na razie przedstawionego kodu, ale mam jedną uwagę do Panów: cokolwiek byście nie robili, to NIGDY nie należy w kodzie umieszczać usuwania jakiś plików! Zdecydowanie będzie lepiej utworzyć jakiś folder, w którym będziemy umieszczać niepotrzebne pliki, czyli w kodzie będziemy je PRZENOSIĆ z jednego katalogu do drugiego.
Co jakiś czas będzie można ręcznie usunąć pliki z tego dodatkowego katalogu, jeśli naprawdę będziemy chcieli zrobić porządek, a i to warto zrobić po zrzuceniu kopii na jakąś płytę CD/DVD.

Drogi Koziorozcu,

niestety pojawil sie blad
"an error occured nr° -2147467259 description: automation error"

dzieje sie to w momencie kiedy klikam na strzalke aby wyswietlic zdjecie, wystepuje tylko w 2 liniach na 15.

co moze byc przyczyna ?