Telefonszámunk: 1-472-0679

[Resolved] Váltakozó képek

Kezdőlap › Fórumok › Excel programozás › [Resolved] Váltakozó képek

Topic Resolution: Resolved
9 bejegyzés megtekintése - 1-9 / 9
  • Szerző
    Bejegyzés
  • 2023-02-03-14:51 #9611
    Potus
    Felhasználó

    helló, szeretnék egy munkalapon beszúrt alakzatra óránként más más üdvözlő képet tenni egy a számitógépen lévő mappából. hogy tudom azt megoldani ?

    Potus

    2023-02-03-16:37 #9614
    delila
    Felhasználó

    Szia,

    Sub Kepek()
    Dim kepszam As Integer, utvonal As String
    
    Application.OnTime Now + TimeSerial(1, 0, 0), "Kepek", , True
    kepszam = Application.WorksheetFunction.RandBetween(1, 7) 'ahány képed van
    utvonal = "D:\Jpg\Új\"  'saját útvonaladat add meg
    ActiveSheet.Shapes.Range("Alakzat").Fill.UserPicture utvonal & kepszam & ".jpg" 'saját alakzatod nevét add meg
End Sub

    A képek neve sorszám legyen. 1.jpg, 2.jpg, stb.

    Delila

    • A hozzászólás módosításra került: 1 month, 2 weeks telt el-delila. Indok: Képnevek
    2023-02-03-17:49 #9616
    Potus
    Felhasználó

    hello!

    hibát jelez

    Attachments:
    You must be logged in to view attached files.
    2023-02-03-17:52 #9618
    Potus
    Felhasználó

    Ezt írja…

    wrong number of arguments or invalid property assignment

    2023-02-04-07:37 #9619
    delila
    Felhasználó

    Nézd meg újra a makrót, amit küldtem, és csak ott változtass, ahol a megjegyzésekben írtam.

    2023-02-04-10:53 #9620
    Potus
    Felhasználó

    Köszi, figyelmetlen voltam. Most már műkődik.

    Nem lehet ezt úgy modosítani, hogy meg tudjam határozni, hogy melyik órában melyik kép jelenjen meg? 🙂

    Előre is köszi! Potus

    2023-02-04-16:10 #9621
    delila
    Felhasználó

    Már tudod, miket kell átírnod a makrókban.

    Option Explicit
    Public kepszam As Integer

    Sub Start()
    Cells(1) = "OK"
    kepszam = 1
    Kepek
End Sub
    Sub Kepek()
    Const utvonal = "D:\Jpg\Új\"
    
    If Cells(1) = "OK" Then
        Application.OnTime Now + TimeSerial(0, 0, 2), "Kepek", , True
        ActiveSheet.Shapes.Range("Alakzat").Fill.UserPicture utvonal & kepszam & ".jpg"
    End If
    kepszam = kepszam + 1
    If kepszam > 7 Then kepszam = 1
End Sub
    Sub Abbhagy()
    Cells(1) = "Stop"
End Sub

    A Start és az Abbhagy makrókat 1-1 gombhoz rendelheted.

    • A hozzászólás módosításra került: 1 month, 2 weeks telt el-delila.
    2023-02-05-16:39 #9627
    Potus
    Felhasználó

    Köszönöm szépen!

    2023-02-06-06:49 #9631
    delila
    Felhasználó

    Szívesen.

  • Szerző
    Bejegyzés
9 bejegyzés megtekintése - 1-9 / 9
  • Be kell jelentkezni a hozzászóláshoz.