ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[mt80]

Kod: Tümünü seç

Sub Makro3()
'
' Makro3 Makro
'

'
    Application.ScreenUpdating = False
    UserForm2.Show 0
    Application.Wait (Now + TimeValue("0:00:01"))

    Sheets("5").Select

    Rows("52:63").Select
    Selection.Copy
    Sheets("sözleşmeyedavet").Select
    Range("A60").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B65").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("A10:K10").Select
    ActiveSheet.Paste

    Range("B63").Select
    Application.CutCopyMode = False
    Selection.Copy
   
    Range("A21:K21").Select
    ActiveSheet.Paste

    Range("N61").Select
    Application.CutCopyMode = False
    Selection.Copy
 
    Range("A12:K14").Select
    ActiveSheet.Paste
   
    Range("N63").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("A15:K15").Select
    ActiveSheet.Paste
 
    Range("N64").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("B16:G16").Select
    ActiveSheet.Paste

    Range("N65").Select
    Application.CutCopyMode = False
    Selection.Copy
   
    Range("H16:K16").Select
    ActiveSheet.Paste
 
    Range("N66").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("A18:K18").Select
    ActiveSheet.Paste

    Range("T68").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("E31:K31").Select
    ActiveSheet.Paste

    Range("T69").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("E32:K32").Select
    ActiveSheet.Paste

    Range("T70").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("E33:K33").Select
    ActiveSheet.Paste

    Range("T67").Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("E35:K35").Select
    ActiveSheet.Paste

    Sheets("5").Select

    Range("A1").Select
    Application.CutCopyMode = False
   
   
        ''''
    'yazı metni oluşturuluyor....
    Sheets("sözleşmeyedavet").Select
    [a20] = "       " & [ı65] & " " & [b68]
    ilk = InStr([a20], [ı65])
    son = Len([ı65])
    [a20].Characters(Start:=ilk, Length:=son).Font.FontStyle = "Kalın"
    [a20].Characters(Start:=ilk, Length:=son).Font.Strikethrough = False
    '
    '
    Sheets("5").Select
    Application.ScreenUpdating = True

    Unload UserForm2


    MsgBox "Sözleşmeye Davet yazısı Oluşturuldu. Yazıcıya Gönderirken mutlaka baskı önizleme kontrolü yap."
   
End Sub

Bu şekilde olan makro var buna ProgressBar eklemeye çalıştım ama bir türlü yapamadım. Yardımcı olabilir misiniz?

[Tarkan VURAL]

Burada bir döngü olmadığında, progress nesnesinin value özelliğine kazandıracağınız değerleri kodlarınızdaki satırlara serpiştirmeniz gerekecek. Bir de progress nesnesi nerede görünecek ? Bu işlemleri bir UserForm üzerinden mi yönetiyorsunuz yoksa sayfada mı ?

[mt80]

Bu işlemler UserFormda değil sayfada yapıyor.. Kodda görünen UserForm bu kodlar çalışırken sadece ekrana geliyor. Ekrana gelen UserForma işlemler bitene kadar ProgressBar eklemeye çalıştım ama bir türlü yapamadım.

[Tarkan VURAL]

Dosyanızı ekleyin, bakalım neler yapılabiliyor...

[mt80]

Dosya Ektedir. Sayfa1 de yer alan bilgiler girildiğinde ilgili yerlere verilerin bazılarını otomatik alıyor bazıları elle seçimi yapılıyor. "5" numaralı sayfada olan bilgiler girildikten sonra makroyla yazılar oluşturuluyor. excelden fazla anlamadığım için biraz karmaşık olmuş olabilir. Yardımlarınız için teşekkürler. (yazdır makrolarını dikkate almayınız.)