- Katılım
- 19 Nisan 2007
- Mesajlar
- 337
- Excel Vers. ve Dili
- Excel 2003 Türkçe
Arkadaşlar forumda birçok örnek buldum. İşin aslı içinden çıkamadam.
Aşağıda kodlarım var.
userforum1 de Progressbar ekledim ve makro işlemi yapana kadar çalışmasını sağlayamadım.
Aşağıdaki makro işleme başladığında başlayacak End sub da o da %100 bulması gerekli
Aşağıda kodlarım var.
userforum1 de Progressbar ekledim ve makro işlemi yapana kadar çalışmasını sağlayamadım.
Aşağıdaki makro işleme başladığında başlayacak End sub da o da %100 bulması gerekli
Kod:
Private Sub yazi_hazirla_Click()
Dim atla1 As Integer
Dim atla2 As Integer
Dim atla3 As Integer
Dim atla4 As Integer
Set bulut = Workbooks("Ş_BULUT_Resmi_Yazışma_arşiv").Worksheets("sayfa1")
Sayfa3.Select
'sayfasına sıra no yazdırılıyor
'*****************************************************
Range("A2").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("A2").Value = "" Then
Range("A2").Value = 1
Range("A2").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
End If
'*********************************************************
ActiveCell.Offset(0, 44).Value = sayi.Text ' Sayı
ActiveCell.Offset(0, 1).Value = baslik_adresyeri.Text
ActiveCell.Offset(0, 2).Value = konu.Text ' Konu
ActiveCell.Offset(0, 3).Value = konu2.Text ' Konu2
ActiveCell.Offset(0, 4).Value = Tarih_gün.Text ' Tarih Gün
ActiveCell.Offset(0, 5).Value = Tarih_ay.Text ' Tarih Ay
ActiveCell.Offset(0, 6).Value = Tarih_yil.Text ' Tarih Yıl
ActiveCell.Offset(0, 7).Value = baslik_1.Text ' Başlık1
ActiveCell.Offset(0, 8).Value = baslik_2.Text ' Başlık2
ActiveCell.Offset(0, 9).Value = yazi_icerigi_1.Text ' Yazı İçeriği1
ActiveCell.Offset(0, 10).Value = yazi_icerigi_2.Text ' Yazı İçeriği2
ActiveCell.Offset(0, 11).Value = arz_rica.Text ' Arz/Rica
ActiveCell.Offset(0, 12).Value = ComboBox1.Text ' Arşiv Birimi
ActiveCell.Offset(0, 13).Value = arsiv_klasor_no.Text ' arsiv_klasor_no
ActiveCell.Offset(0, 14).Value = arsiv_dosya_no.Text ' arsiv_dosya_no
ActiveCell.Offset(0, 15).Value = txt_ilgi_var.Text 'İlgi
ActiveCell.Offset(0, 16).Value = txt_ek_1.Text 'İlgi
ActiveCell.Offset(0, 17).Value = txt_ek_2.Text 'İlgi
ActiveCell.Offset(0, 18).Value = txt_ek_3.Text 'İlgi
ActiveCell.Offset(0, 19).Value = txt_ek_4.Text 'İlgi
ActiveCell.Offset(0, 20).Value = txt_ek_5.Text 'İlgi
ActiveCell.Offset(0, 21).Value = txt_dagitim_1.Text 'Dağıtım
ActiveCell.Offset(0, 22).Value = txt_dagitim_2.Text 'Dağıtım
ActiveCell.Offset(0, 23).Value = txt_dagitim_3.Text 'Dağıtım
ActiveCell.Offset(0, 24).Value = txt_dagitim_4.Text 'Dağıtım
ActiveCell.Offset(0, 25).Value = txt_dagitim_5.Text 'Dağıtım
ActiveCell.Offset(0, 26).Value = txt_bilgi_1.Text 'Bilgi
ActiveCell.Offset(0, 27).Value = txt_bilgi_2.Text 'Bilgi
ActiveCell.Offset(0, 28).Value = txt_bilgi_3.Text 'Bilgi
ActiveCell.Offset(0, 29).Value = txt_bilgi_4.Text 'Bilgi
ActiveCell.Offset(0, 30).Value = txt_bilgi_5.Text 'Bilgi
ActiveCell.Offset(0, 59).Value = resen_aidiat_konu_no.Text
If ComboBox1.Text = Sayfa1.[E100] Then
ActiveCell.Offset(0, 63).Value = 1
Else
ActiveCell.Offset(0, 63).Value = 0
End If
Sayfa2.Select
Cells.Select
Selection.ClearContents
[C3] = "T.C."
If ToggleButton1.Value = True Then
[C4] = Sayfa1.[C2] & " VALİLİĞİ"
Else
[C4] = Sayfa1.[C3] & " KAYMAKAMLIĞI"
End If
[C5] = Sayfa1.[C4]
[C7] = "Sayı : " & bulut.[C5].Value & " / " & sayi.Text
[BG7] = "'" & Tarih_gün & "/" & Tarih_ay & "/" & Tarih_yil
[C8] = "Konu :"
[H8] = konu & " " & konu2
[C11] = baslik_1
[C12] = baslik_2
[AT13] = baslik_adresyeri
'----------- İlgi Var / Yok -------------------
If ilgi_var = True Then
[C14] = "İlgi : " & txt_ilgi_var.Text
Rows("14:15").RowHeight = 15.75
Else
Rows("14:15").Select
Selection.EntireRow.Hidden = True
[C14] = ""
End If
'------------------------------------------------------
[C16] = " " & yazi_icerigi_1
'------------------- İKİNCİ PARAGRAF -----------------------------------
If ikinci_paragraf_kapat = True Then
Rows("26:30").Select
Selection.EntireRow.Hidden = True
Else
Rows("26:30").RowHeight = 15.75
[C26] = " " & yazi_icerigi_2
yazi_icerigi_2.Locked = False
End If
'------------------------------------------------------
[H31] = arz_rica
[AX32] = Sayfa1.[C13] & " " & Sayfa1.[D13]
[AX33] = Sayfa1.[F13]
[AX34] = Sayfa1.[E13]
'------------------ EKLER KISMI --------------------------------
If ek_var = True Then
[C35] = "E K L E R :"
[C35].Font.Underline = xlUnderlineStyleSingle
[C36] = txt_ek_1
[C37] = txt_ek_2
[C38] = txt_ek_3
[C39] = txt_ek_4
[C40] = txt_ek_5
Else
[C35].Font.Underline = xlUnderlineStyleNone
[C35] = ""
[C37] = ""
[C37] = ""
[C38] = ""
[C39] = ""
[C40] = ""
End If
'--------------------- DAĞITIM KISMI -------------------------
If dagitim_var = True Then
[C41] = "D A Ğ I T I M :"
[C41].Font.Underline = xlUnderlineStyleSingle
[C43] = txt_dagitim_1
[C44] = txt_dagitim_2
[C45] = txt_dagitim_3
[C46] = txt_dagitim_4
[C47] = txt_dagitim_5
Else
[C41] = ""
[C41].Font.Underline = xlUnderlineStyleNone
[C43] = ""
[C44] = ""
[C45] = ""
[C46] = ""
[C47] = ""
End If
'------------------------------------------------------
'--------------------- GEREĞİ KISMI -------------------------
If geregi_var = True Then ' :
[C42] = "Gereği :"
[C42].Font.Underline = xlUnderlineStyleSingle
Else
[C42] = ""
[C42].Font.Underline = xlUnderlineStyleNone
End If
'------------------------------------------------------
'--------------------- BİLGİ KISMI -------------------------
If bilgi_var = True Then
[AH42] = "Bilgi :"
[AH42].Font.Underline = xlUnderlineStyleSingle
[AH43] = txt_dagitim_1
[AH44] = txt_dagitim_2
[AH45] = txt_dagitim_3
[AH46] = txt_dagitim_4
[AH47] = txt_dagitim_5
Else
[AH42] = ""
[AH42].Font.Underline = xlUnderlineStyleNone
[AH43] = ""
[AH44] = ""
[AH45] = ""
[AH46] = ""
[AH47] = ""
End If
'------------------------------------------------------
[C50] = [BG7] & " " & Sayfa1.[H9] & "." & Sayfa1.[d9] & " (.....)" ' Yazıyı Hazırlayan
[C51] = [BG7] & " " & Sayfa1.[H10] & "." & Sayfa1.[d10] & " (.....)" '1.İmza
[C52] = [BG7] & " " & Sayfa1.[H11] & "." & Sayfa1.[d11] & " (.....)" '2.İmza
[C53] = [BG7] & " " & Sayfa1.[H12] & "." & Sayfa1.[d12] & " (.....)" '3.İmza
If Sayfa1.[C10] = "" Then '1.İmza Boşsa
[C50] = ""
[C51] = ""
[C52] = ""
[C53] = [BG7] & " " & Sayfa1.[H9] & "." & Sayfa1.[d9] & " (.....)" ' Yazıyı Hazırlayan
Else
If Sayfa1.[C11] = "" Then '2.İmza Boşsa
[C50] = ""
[C51] = ""
[C52] = [BG7] & " " & Sayfa1.[H9] & "." & Sayfa1.[d9] & " (.....)" ' Yazıyı Hazırlayan
[C53] = [BG7] & " " & Sayfa1.[H10] & "." & Sayfa1.[d10] & " (.....)" '1.İmza
Else
If Sayfa1.[C12] = "" Then '2.İmza Boşsa
[C50] = ""
[C51] = [BG7] & " " & Sayfa1.[H9] & "." & Sayfa1.[d9] & " (.....)" ' Yazıyı Hazırlayan
[C52] = [BG7] & " " & Sayfa1.[H10] & "." & Sayfa1.[d10] & " (.....)" '1.İmza
[C53] = [BG7] & " " & Sayfa1.[H11] & "." & Sayfa1.[d11] & " (.....)" '2.İmza
End If
End If
End If
Range("C53:BQ53").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
[C54] = Sayfa1.[C15]
[AY54] = "Ayrıntılı Bilgi için İrtibat :" & Sayfa1.[H9] & "." & Sayfa1.[d9]
[C55] = "Telefon : " & Sayfa1.[C16] & " Faks :" & Sayfa1.[C17] & " GSM : " & Sayfa1.[C18] & " mail : " & Sayfa1.[C19]
'B45 ile B60 arasında boş hücreleri gizle
'[B45:B60].SpecialCells(4).EntireRow.Hidden = 1
MsgBox "Yeni " & baslik_1.Text & " Üst Yazı kaydı tamamlandı.", , "Tebrikler"
ActiveWorkbook.Save
End Sub