• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Zašednuté políčka u vieweru - tisk obrázku z VBA

Zaslal/a Marekkoc 25.2.2015 15:32

Zdravím všechny,

už jsem dal dohromady zobrazování obrázků v "Prohlížeči fotografií" po kliknutí na buňku v excelu. Ale objevil se mi problém s tím, že obrázek nelze vytisknout, protože některá políčka viz příloha jsou zašedlé.
Může mi s tím někdo pomoct?
Děkuju MArek

Kód je:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Path As String, s As String


'první část odkazu

Path = "http://8.6.3.5:8080/PumpaServer/get_doc.pl?doc_id="


If Not Intersect(Target, Range("J12:J100")) Is Nothing And Target.Count = 1 Then

If IsNumeric(Target) And Len(Target) > 0 Then

'druhá část odkazu

s = Left(Target, Len(Target) - 2)


'otevrit odkaz

Shell "RunDLL32.exe C:\Windows\System32\Shimgvw.dll,ImageView_Fullscreen " & Path & s

End If

End If

End Sub

Příloha: 23855_prohlizec-fotografii.zip (7kB, staženo 28x)

Zaslat odpověď >

---

Marekkoc(25.2.2015 17:04)#023860

možná je to tím, že je soubor zamčený. Našel jsem kod který to řeší, ale nevím jak ho zapasovat do mého stávajícího kodu.

Code :Private Sub B_ViewFull_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles B_ViewFull.Click
Dim fi As New System.IO.FileInfo(PathOfFile)
fi.Attributes = IO.FileAttributes.Normal

'following starts Windows Photo and Fax Viewer
Process.Start("C:\windows\system32\rundll32.exe", "C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscreen " & PathOfFile)
End Subcitovat

kp57(25.2.2015 20:31)#023866

Ahoj, takhle přímo se mi to nedaří ani načíst.
Ale když ten jpg stáhnu do PC, pak bez problému.Private Declare Function URLDownloadToFile Lib "URLMON" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub DownLoad_Image_2()
Dim WebName As String, MyName As String, pzcx As Long, s As String
WebName = "http://img8.rajce.idnes.cz/d0803/6/6007/6007335_7fecf8904d46fb67d2998f7ae33776aa/images/2194.jpg?ver=0"
MyName = ThisWorkbook.Path & "\" & "MyFoto.jpg"
pzcx = URLDownloadToFile(0, WebName, MyName, 0, 0)
If Not pzcx Then
Shell "RunDLL32.exe C:\Windows\System32\Shimgvw.dll,ImageView_Fullscreen " & MyName
Else
MsgBox "CHYBA " & pzcx, , "DownLoad_Image"
End If
End Sub
citovat

Marekkoc(26.2.2015 8:40)#023869

Ahoj, tím to směrem jsem se začal ubírat nejdříve stáhnout a potom otevřít, ale narazil jsem s tím jak to zakomponovat do mého kódu. Používám jej tak že v buňkách mám 8 místné číslo ( např. 12345678) u kterého smažu poslední dvě s = Left(Target, Len(Target) - 2) a toto šesti místné číslo (123456) dosadím http://8.6.3.5:8080/PumpaServer/get_doc.pl?doc_id=123456" a otevřu.

Věděl by si jak na to?

Děkuju.citovat

Marekkoc(26.2.2015 8:42)#023870

Jelikož se jedná o dočasný soubor, mohl by se po zobrazení smazat ?citovat

kp57(26.2.2015 19:53)#023890

To je odkaz na nějaký firemní server? No abych řekl pravdu, nevím o jaký souborový formát se jedná.
Nahoře píšeš, že se ti daří (až na tu nabídku) ten soubor zobrazit v prohlížeči přímo z toho odkazu. Opravdu? Mně ne.
Prvni zkus, s jedním konkrétním souborem, jestli ho ta Fce "URLDownloadToFile" vůbec stáhne.
Soubor otevři v prohlížeči, jestli je tento formát podporovaný. Pak to dosaď do toho kódu, co máš nahoře, podle mě je v pořádku.
A asi při zavírání sešitu ten "temp" odstraň.
Jinak nevím jak poradit, nemám na čem vyzkoušet.citovat

Marekkoc(27.2.2015 7:34)#023897

Ahoj Tvůj kód funguje v pohodě i položky jako print atd. jsou dostupné. Jen nevím jak ho zapasovat do mého kódu a ještě udělat to, aby se soubor smazal po otevření ve vieweru. Děkuju za pomoc. MArekcitovat

Marekkoc(27.2.2015 10:38)#023901

Tak jsem ještě koumal a nejjednodušší by bylo uložit obrázek do TEMP, mám to ve windows jako proměnou. A tvůj kód napasovat na můj. Předem díky za pomoc. Marekcitovat

Marekkoc(27.2.2015 11:22)#023904

Ahoj..tak už jsem přišel na i ukládání souboru do TEMP. Prosím jen tedy o integraci tohoto kódu do mého což je asi nad mé síly. Děkuju.

Private Declare Function URLDownloadToFile Lib "URLMON" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Sub DownLoad_Image_2()

Dim WebName As String, MyName As String, pzcx As Long, s As String

WebName = "http://1.2.3.6:8080/PumpaServer/get_doc.pl?doc_id=11111"

MyName = Environ("temp") & "\MyFoto.jpg"

pzcx = URLDownloadToFile(0, WebName, MyName, 0, 0)

If Not pzcx Then

Shell "RunDLL32.exe C:\Windows\System32\Shimgvw.dll,ImageView_Fullscreen " & MyName

Else

MsgBox "CHYBA " & pzcx, , "DownLoad_Image"

End If

End Subcitovat

kp57(27.2.2015 23:00)#023917

Ty stahované soubory jsou ve formátu JPG ?
Pak ten kód v Modulu Listu by vypadal nějak takto:
Option Explicit
Private Declare Function URLDownloadToFile Lib "URLMON" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J12:J100")) Is Nothing And Target.Count = 1 Then
If IsNumeric(Target) And Len(Target) > 2 Then
Dim WebName As String, WebId As Long, MyName As String, pzcx As Long
WebId = Int(Target / 100)
WebName = "http://8.6.3.5:8080/PumpaServer/get_doc.pl?doc_id=" & WebId
MyName = Environ("temp") & "\MyFoto.jpg" 'JPG je OK?
pzcx = URLDownloadToFile(0, WebName, MyName, 0, 0)
Application.Wait (Now + TimeValue("0:00:01"))
If Not pzcx Then
Shell "RunDLL32.exe C:\Windows\System32\Shimgvw.dll,ImageView_Fullscreen " & MyName
Else
MsgBox "CHYBA " & pzcx, , "DownLoad_Image"
End If
End If
End If
End Sub

No a ten "Temp.???" soubor se nemůže smazat, dokud ho máš v prohlížeči.
Takže asi až v Modulu Sešitu při zavírání sešitu.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim MyName As String
MyName = Environ("temp") & "\MyFoto.jpg"
If Not Dir(MyName) = vbNullString Then Kill MyName
End Sub
citovat

Marekkoc(2.3.2015 15:00)#023946

Ahoj, děkuju moc za pomoc. Ať se ti to mnohokrát vrátí. Funguje to bezvadně. Marekcitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse