Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Excel VBA pomoc se vzorcem

Stavaj na tomto:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$F$5" Then
    Dim N As String
    Const Cesta = "F:\002. Fotky Osobností\"
    N = Cells(5, 6)
    If N <> "" Then
      N = Cesta & N
      Select Case True
        Case Len(Dir(N & ".png")) > 0: Call ZmenObrazok(N & ".png")
        Case Len(Dir(N & ".jpg")) > 0: Call ZmenObrazok(N & ".jpg")
        Case Len(Dir(N & ".gif")) > 0: Call ZmenObrazok(N & ".gif")
        Case Len(Dir(N & ".bmp")) > 0: Call ZmenObrazok(N & ".bmp")
      End Select
    Else
'      Shapes("imgHDD").Fill.Solid
    ActiveSheet.DrawingObjects.Delete
    End If
  End If
End Sub

Private Sub ZmenObrazok(S As String)
'  Shapes("imgHDD").Fill.UserPicture (S)
    On Error Resume Next
    Range("A1").Select
    ActiveSheet.DrawingObjects.Delete
    ActiveSheet.Pictures.Insert(S).Select
    Range("F5").Select
End Sub
Neoživil som to na udalosť Calculate, tak som to poriešil na WorkSheet_Change.
Hľadal som riešenie na aktualizáciu obrázka podľa obsahu bunky F5
Vyskúšaj si to, ale s tým, že musíš priamo prepisovať F5. "Aktualizácia", t.j. prepísanie obrázka, bude fungovať.
Potom treba poriešiť to, že bunka F5 obsahuje vzorec a teda, ako píše Machr555, procedúra sa nespustí.
Dá sa to ale obísť tak, že nájdeš vhodný spúšťač (ako vidím, vytváral si formulár, neskúmal som ho ale hneď ma napadá možnosť spúšťania zmenou vhodného prvku na formulári).

Tento spôsob Ti naplní obrázok do aktuálnej bunky, teda aký veľký bude obrázok, s takou veľkosťou sa načíta... Pokiaľ sú obrázky rôznych rozmerov, musíš si to poriešiť prispôsobujúcimi výpočtami.

P.S. pokiaľ je východzí stav bez obrázka, bude potrebné doplniť i do prvej procedúry príkaz On Error Resume Next (ak však môže nastať chyba i z iného dôvodu, musíš príkaz On Error ošetriť inak)

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny