99
« Poslední příspěvek od j kdy 20. 10. 2016, 18:07:19 »
Koukám stále nezodpovězeno i po 5 letech. Zrovna řeším podobný problém a nic nenacházím (našel jsem právě jen tuto pravěkou diskuzi) - všechny programy (včetně samotných windows počínaje snad už verzemi 9x) umí udělat náhledy na obrazovku, ale bez možnosti tisku, irfanview něco takového možná umělo, stálo by to za pokus, mě jeho výsledky kdysi neuspokojovaly.
Dospěl jsem ke skriptu v kancelářském programu microsoft word (neumím ale to samé udělat v libre office, tam ty skripty fungují jinak). Třeba se to někomu hodí.
Vlastně jsem něco podobného řešil už asi před 10 lety, v době, kdy jsem si pořídil první digitální fotoaparát. Zkoušel jsem jak generátor HTM tak právě skript ve vordu (pro HTM ale bylo nutné zkonvertovat (zmenšit) obrázky, aby načítání netrvalo 2O let). Našel jsem výsledky (několik souborů s náhledy svých prvních fotek), ale skript jakoby se propadnul do země a než prohledávat 10 let staré soubory nebo zálohy, to jsem si říkal, že bude rychlejší napsat znovu, vždyť to není až tak složitý problém.
V té době jsem dospěl ke kompromisnímu počtu sedmi sloupců, při kterém jsou obrázky ještě dost "čitelné." V novém skriptu jsem nechal tento počet volitelný. Pět sloupců vede na dost velké obrázky, 10 sloupců udělá (na A4) obrázky velikosti poštovní známky na kterých je poznat les od moře. Pak jsem neměl dlouho čas si s tím hrát, takže tehdejší pokusy zapadly v prachu dějin.
Současnou podobu sktriptu, který ale ještě vyžaduje mnoho úprav, přikládám níže. Doplnil jsem jej o komentáře.
Raději bych to viděl v libreoffice, který mám na více počítačích (ten m$ mám jen na jednom, je moc drahý). Bohužel LO nemá ani dokumentaci makrojazyka ani záznam maker (ani další vymoženosti běžné ve vývojových prostředích) a makro přenesené z m$ v lo nefunguje (objekty a jejich metody existují asi pod jinými názvy a není možné zjistit pod jakými a tak většina příkazů z wordu nefunguje). Proměnné s diakritikou kupodivu LO nevadí.
K použití: Sktript je možné vložit do globální šablony nebo do libovolného dokumentu do libovolného modulu maker. Pro experimenty je nejlépe jej vložit do nového prázdného dokumentu. Konfigurace se děje pomocí proměnných, ovládací formulář vytvořím později, pokud vůbec. Nastavuje se počet sloupců (který určuje velikost miniatur) i počet řádků (který určuje jejich počet). Není (zatím) rozumně ošetřen konec, tedy musí být obrázků přinejmenším stejně jako řádkyxsloupce. Opačná situace není testovaná, ale pravděpodobně dojde k přerušení běhu buď na konci souboru nebo při pokusu načíst obrázek s prázdným řetězcem. Dále je nutné upravit jméno souboru se seznamem a počet znaků cesty, které se nemají kopírovat do popisku. Dále je možné měnit okraje a podobné drobnosti.
Sub FotPokW()
'
' FotPok Makro
' Makro zaznamenáno 18.10.2016, zaznamenal xxx
'
psl = 10 'počet sloupců
POC = 10 'počet řádků 'pozor není zatím ošetřen konec, obrázků musí být stejně nebo více, než řádků x sloupců
Documents.Add DocumentType:=wdNewBlankDocument 'Nový dokument
With ActiveDocument.PageSetup 'Zmenšení výchozích okrajů, 1 cm je tak akorát, výchozí 1 palec je příliš
.TopMargin = CentimetersToPoints(1)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
End With
'Vložení tabulky pro náhledy
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
psl, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
'Tohle přidal Word při záznamu makra, myslím, že to je zbytečné, ale nechávám to
With Selection.Tables(1)
If .Style <> "Mřížka tabulky" Then
.Style = "Mřížka tabulky"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
'šířka miniatury = stránka zmenšená o okraje podělená počtem miniatur na řádce, navíc je ubraný milimetr jako korekce (možná by stačilo i půl, nula ale ne)
š = (ActiveDocument.PageSetup.PageWidth - ActiveDocument.PageSetup.LeftMargin - ActiveDocument.PageSetup.RightMargin) / psl - MillimetersToPoints(1)
'V této verzi jsem neřešil procházení adresáře/adresářů. Lze to we vordu udělat stylem jako ve starém pascalu (nerekurzivně).
'Zde používám předem připravený seznam souborů, ve kterém je fullpath každé jednotlivé fotky na samostatném řádku (lze pohodlně vytvořit např v double commanderu nebo prostě dir *.jpg /s/b >seznobr.txt v příkazovém řádku windows)
Open "X:\SeznObr.txt" For Input As #1 'zde nahraďte můj název seznamu mezi uvozovkami tím vaším
potlacit=20 'kolik znaku z fullpath souboru oříznout
For J = 1 To POC Step 1
For I = 1 To psl Step 1
Line Input #1, obr
With Selection.Cells(1)
.TopPadding = CentimetersToPoints(0)
.BottomPadding = CentimetersToPoints(0)
.LeftPadding = CentimetersToPoints(0)
.RightPadding = CentimetersToPoints(0)
.FitText = True
End With
With Selection.InlineShapes.AddPicture(obr)
k = .Width
l = .Height
.Width = š 'tady by bylo lepší použít metodu proportional width; v době psaní jsem o ní nevěděl
.Height = l / k * š
End With
Selection.Font.Size = 6 'aby se to tam vešlo
Selection.TypeText Text:=Chr$(10) & Replace(Mid$(obr, potlacit), "\", Chr$(13))
Selection.MoveRight Unit:=wdCharacter, Count:=1
Next I
Selection.MoveRight Unit:=wdCell, Count:=1
Next J
Close #1
End Sub
Poslední příspěvky
