Zamana Göre Label'in etiket bilgisini değiştirmek

Katılım
10 Mart 2022
Mesajlar
1
Excel Vers. ve Dili
Excel 2016 Türkçe
Bir userform üzerinde bir adet buton, bir adet textbox ve sonuç almak için kullandığım label var. Bir adet metin belgem var, içinde 1000 ile 5000 kelime mevcut. Metin kutusuna milisaniye cinsinden sayısal veri gireceğim. Butona bastığımda metin belgesindeki kelimeleri sırasıyla göstermesini istiyorum. Metin değişim hızı userformdaki textbox'a girdiğim sürede olmalı. Fikir edinmek için formu ve interneti biraz karıştırdım ama neye bakacağımı bilmediğim için aramalarımdan netice alamadım. Nasıl bir kod yazmam gerektiği konusunda yardımcı olur musunuz?
 
Katılım
6 Mart 2024
Mesajlar
103
Excel Vers. ve Dili
Excel 2010 TR & Excel 2016 TR
Merhaba,
Kod:
Option Explicit
' Biolight 2024 - Eppur Si Muove

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' UserFormda Bulunması gereken Controls ve İsimleri(Name)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Button 2 adet isimleri ( DosyaButton ve BaslaButton )
' ComboBox 1 Adet ismi ( BeklemeSure )
' Label 1 Adet ismi ( PrompterLabel )
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub UserForm_Initialize()
    Dim i As Integer
   
    ' Bekleme sürelerini ekle
    For i = 1 To 40
        BeklemeSure.AddItem Format(i, "00")
    Next i
    BeklemeSure.Value = "01" ' Varsayılan değer
    BeklemeSure.Style = 2 ' ComboBox sadece seçim yapılabilir hale gelir.
    BeklemeSure.ControlTipText = "Kelime Gösterme Süresi"
   
    Me.Caption = "Prompter V1"
   
    BaslaButton.Caption = "Başla"
    BaslaButton.Enabled = False
    
    DosyaButton.Caption = "Gözat..."
    
    PrompterLabel.Caption = ""
   
End Sub

Private Sub DosyaButton_Click()
    Dim DosyaSecim As Variant
   
    ' Dosya Seçimi ( Text dosyanızın Kodlamasının ANSI olmasına dikkat ediniz, türkçe karekterler hatalı çıkabilir.)
    DosyaSecim = Application.GetOpenFilename("Text Dosyalar,*.txt", , "Görüntülemek istediğiniz TEXT dosyasını seçiniz", , False)

    ' İptal edilip edilmediğini kontrol et
    If DosyaSecim <> False Then
        DosyaButton.Caption = Dir(DosyaSecim)
        DosyaButton.ControlTipText = DosyaSecim ' Dosyanın tam yolu
        BaslaButton.Enabled = True
    Else
        DosyaButton.Caption = "Gözat..."
        DosyaButton.ControlTipText = ""
        BaslaButton.Enabled = False
    End If
End Sub

Private Sub BaslaButton_Click()
    If DosyaButton.ControlTipText = "" Then Exit Sub
   
    BaslaButton.Enabled = False
   
    Dim dosyaYolu As String
    Dim dosyaNumarasi As Integer
    Dim metin As String
    Dim kelimeler() As String
    Dim kelimeSayisi As Long
    Dim i As Long
    Dim beklemeSuresi As Integer
   
    ' Dosya yolunu al
    dosyaYolu = DosyaButton.ControlTipText
   
    ' Dosyayı açmak için dosya numarası al
    dosyaNumarasi = FreeFile
   
    ' Dosyayı aç ve tüm içeriği oku
    Open dosyaYolu For Input As dosyaNumarasi
    metin = Input(LOF(dosyaNumarasi), dosyaNumarasi)
    Close dosyaNumarasi
   
    ' Metni boşluklardan ayırarak kelimeleri bul
    kelimeler = Split(metin, " ")
   
    ' Kelime sayısını hesapla
    kelimeSayisi = UBound(kelimeler) + 1
   
    ' Bekleme süresi (ComboBox'tan alınan değeri integer'a çevir)
    beklemeSuresi = CInt(BeklemeSure.Value)
   
    ' Kelimeleri sırayla göster
    For i = 0 To kelimeSayisi - 1
        PrompterLabel.Caption = kelimeler(i) ' Kelimeyi göster
        DoEvents ' Formun diğer işlemleri için bekletme
       
        ' Bekleme süresi kadar dur
        Application.Wait Now + TimeValue("00:00:" & Format(beklemeSuresi, "00"))
    Next i
   
    ' Döngü bittiğinde PrompterLabel'ı temizle
    PrompterLabel.Caption = ""
   
    BaslaButton.Enabled = True
End Sub
Düzenleme : Kodlar güncellendi (30.09.2024 22:28 )
 
Son düzenleme:
Üst