- Katılım
- 13 Ekim 2017
- Mesajlar
- 178
- Excel Vers. ve Dili
- 2003-tr
Merhaba ;
Sayfa 1'de I Karesinde değerler var. Sayfa1'e koyduğum bir tuşla eğer H karesinde "X" işareti var ve I karesi de doluysa, I karesinin içeriğini sayfa adı alarak sayfa oluşturuyor. Ayrıca bir tane CheckBox'um var ve eğer işaretliyse, ona göre bir sayfa oluşuyor. İstediğim şey mükerrer sayfa oluşmasını engellemek ve uyarı mesajı göstermek.
Aşağıdaki kod ile bir şeyler denedim ama başaramadım. Sayfa olmamasına rağmen uyarı verdi ya da uyarı vermesine rağmen sayfayı oluşturdu.
Sayfa ekleme kodum aşağıda.
Şimdiden teşekkürler.
Sayfa 1'de I Karesinde değerler var. Sayfa1'e koyduğum bir tuşla eğer H karesinde "X" işareti var ve I karesi de doluysa, I karesinin içeriğini sayfa adı alarak sayfa oluşturuyor. Ayrıca bir tane CheckBox'um var ve eğer işaretliyse, ona göre bir sayfa oluşuyor. İstediğim şey mükerrer sayfa oluşmasını engellemek ve uyarı mesajı göstermek.
Aşağıdaki kod ile bir şeyler denedim ama başaramadım. Sayfa olmamasına rağmen uyarı verdi ya da uyarı vermesine rağmen sayfayı oluşturdu.
Kod:
'For i = 1 To Worksheets.Count
'If Worksheets(i).Name =
Sayfa ekleme kodum aşağıda.
Şimdiden teşekkürler.
Kod:
Sub SAYFA_OLUSTUR()
Dim mesaj As VbMsgBoxResult
Dim SAYFA_ADI As Variant, ilk As Variant, son As Variant
Dim v As Variant, a As Variant, b As Variant, ara As Variant
Dim s_ilk As Variant, s_son As Variant, mesaj2 As VbMsgBoxStyle
Dim y As Integer, c As Variant, d As Variant, k As Variant
Dim x As Variant, son2 As Integer, i As Integer
Dim SAYFA As Worksheet
mesaj = MsgBox("Sayfa oluşturmak istiyor musunuz?", vbYesNo + vbQuestion, "SAYFA OLUŞTUR")
Select Case mesaj
Case Is = vbYes
Application.ScreenUpdating = False
On Error Resume Next
ilk = 2
son = Range("J" & Rows.Count).End(4).Row
a = Worksheets.Count
If Not sayfa1.CheckBox1 = True Then GoTo atla
'For i = 1 To Worksheets.Count
'If Worksheets(i).Name = "İhraç-2017-" & Range("M2").Value & " VD" Then
'mesaj2 = MsgBox("İhraç-2017-" & Range("M2").Value & " VD sayfası zaten var!", vbOKOnly + vbExclamation, "HATA!")
'Next i
'Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "İhraç-2017-" & Range("M2").Value & " VD"
Call İhr_Dönem_Sayfası_Oluşturma
'End If
atla:
Set ara = Range("H2:H65536").Find("X", , xlValues, xlWhole)
If ara Is Nothing Then GoTo atla3
atla3:
Set ara = Range("H1:H65536").Find("x", , xlValues, xlWhole)
If ara Is Nothing Then
mesaj2 = MsgBox("Oluşturulacak sayfa işaretlenmemiş! İşaretleyip tekrar deneyin.", vbOKOnly + vbExclamation, "HATA!")
Exit Sub
End If
For v = 2 To son
If Range("H" & ilk).Value = "x" Then
Range("H" & ilk).Value = "X"
End If
For y = 2 To son
If Not Range("H" & ilk).Value = "X" Then GoTo atla2
SAYFA_ADI = Range("L" & ilk).Value
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = SAYFA_ADI & "_İhr"
Call İhracat_Sayfa_Oluştur
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = SAYFA_ADI & "_Gümrük"
Call Gümrük_Sayfası_Oluştur
atla2:
ilk = ilk + 1
Next y
Next v
If Worksheets.Count > a Then
mesaj = MsgBox("Sayfa oluşturma başarıyla tamamlanmıştır", vbOKOnly + vbInformation, "SAYFA OLUŞTURMA")
Else
mesaj = MsgBox("Sayfa oluşturma işlemi iptal edilmiştir", vbOKOnly + vbExclamation, "HATA!")
End If
sayfa1.Select
Call ListBox_Güncelle
Case Is = vbNo
End Select
End Sub
Son düzenleme:
