Soru Uyarı verme

sirkülasyon

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,532
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Kod: 
Private Sub CommandButton1_Click()
Set Personel = Worksheets("Personel")
cevap = MsgBox("Verileri güncellek istiyor musunuz?", vbYesNo + vbExclamation, "İşlem Mesajı")
If cevap = vbYes Then
On Error Resume Next
Aranan = TextBox1.Value
Set ara = Sheets("Personel").Range("C:C").Find(Aranan, , xlValues, xlWhole)
Sheets("Personel").Cells(ara.Row, "C") = TextBox1.Value
Sheets("Personel").Cells(ara.Row, "B") = TextBox2.Value
Sheets("Personel").Cells(ara.Row, "U") = TextBox3.Value
Sheets("Personel").Cells(ara.Row, "V") = TextBox4.Value
Sheets("Personel").Cells(ara.Row, "S") = TextBox5.Value
Sheets("Personel").Cells(ara.Row, "Y") = TextBox9.Value
Sheets("Personel").Cells(ara.Row, "Z") = TextBox10.Value
Sheets("Personel").Cells(ara.Row, "X") = TextBox11.Value

Sheets("Personel").Cells(ara.Row, "AA") = TextBox13.Value
Sheets("Personel").Cells(ara.Row, "AB") = TextBox14.Value



MsgBox "verilerinizde Değişiklik yapıldı", , "UYARI"
UserForm6.Show
With Label6
            .Visible = True
            .ForeColor = &H8000000D
            .Caption = "Veriler Güncellendi!!!"
            End With
            
          
            endtime = Now() + Seconds
            Application.Wait (endtime + TimeValue("00:00:02"))
            Label6.Visible = False
            
        Else
            Exit Sub
        End If
          
    
End Sub
yukarıda ki kod ile sayfaya aktarıyorum. Yalnız ikinci bir sefer aktardığımda.
"İkinci kez aktarmak üzeresiniz. Tekrar Aktarmak istiyor musunuz?" Evet ise aktarsın Hayır ise aktarmasın
Rica etsem böyle bir ekleme yapabilir misiniz?
 
Trilenium

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,289
Excel Vers. ve Dili
Microsoft Office 2019 English
sirkülasyon' Alıntı:
Kod: 
Private Sub CommandButton1_Click()
Set Personel = Worksheets("Personel")
cevap = MsgBox("Verileri güncellek istiyor musunuz?", vbYesNo + vbExclamation, "İşlem Mesajı")
If cevap = vbYes Then
On Error Resume Next
Aranan = TextBox1.Value
Set ara = Sheets("Personel").Range("C:C").Find(Aranan, , xlValues, xlWhole)
Sheets("Personel").Cells(ara.Row, "C") = TextBox1.Value
Sheets("Personel").Cells(ara.Row, "B") = TextBox2.Value
Sheets("Personel").Cells(ara.Row, "U") = TextBox3.Value
Sheets("Personel").Cells(ara.Row, "V") = TextBox4.Value
Sheets("Personel").Cells(ara.Row, "S") = TextBox5.Value
Sheets("Personel").Cells(ara.Row, "Y") = TextBox9.Value
Sheets("Personel").Cells(ara.Row, "Z") = TextBox10.Value
Sheets("Personel").Cells(ara.Row, "X") = TextBox11.Value

Sheets("Personel").Cells(ara.Row, "AA") = TextBox13.Value
Sheets("Personel").Cells(ara.Row, "AB") = TextBox14.Value



MsgBox "verilerinizde Değişiklik yapıldı", , "UYARI"
UserForm6.Show
With Label6
            .Visible = True
            .ForeColor = &H8000000D
            .Caption = "Veriler Güncellendi!!!"
            End With
           
         
            endtime = Now() + Seconds
            Application.Wait (endtime + TimeValue("00:00:02"))
            Label6.Visible = False
           
        Else
            Exit Sub
        End If
         
   
End Sub
yukarıda ki kod ile sayfaya aktarıyorum. Yalnız ikinci bir sefer aktardığımda.
"İkinci kez aktarmak üzeresiniz. Tekrar Aktarmak istiyor musunuz?" Evet ise aktarsın Hayır ise aktarmasın
Rica etsem böyle bir ekleme yapabilir misiniz?
Genişletmek için tıkla ...



Set Personel = Worksheets("Personel")
if Range("XFD1").value = 0 then ' Bu hücreyi kullanmıyorsanız buraya bir değer ataması yaparım. 0 ise ilk soruyu sorsun. ve aktardıktan sonra o hücreye 1 yazsın.. Eğer hücre değeri 1 ise ikinci defa soruyu sordurtur devam ederim.. İlk aklıma gelen bu oldu.


cevap = MsgBox("Verileri güncellek istiyor musunuz?", vbYesNo + vbExclamation, "İşlem Mesajı")
If cevap = vbYes Then

...
...
...
Sheets("Personel").range("XFD1") = "1"
else
cevap = MsgBox(""İkinci kez aktarmak üzeresiniz. Tekrar Aktarmak istiyor musunuz?" , vbYesNo + vbExclamation, "İşlem Mesajı")
....
...
...
..

Sheets("Personel").range("XFD1") = "1"
end if
 
sirkülasyon

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,532
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Üstad
1 yazdı.
İkinci aktarmayı yapmıyor.
Ancak uyarı kısmını yapamadım
 
Trilenium

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,289
Excel Vers. ve Dili
Microsoft Office 2019 English
sirkülasyon' Alıntı:
Üstad
1 yazdı.
İkinci aktarmayı yapmıyor.
Ancak uyarı kısmını yapamadım
Genişletmek için tıkla ...
Private Sub CommandButton1_Click()
Set Personel = Worksheets("Personel")
If Sheets("Personel").Range("XFD1").Value = "0" Then

cevap = MsgBox("Verileri güncellek istiyor musunuz?", vbYesNo + vbExclamation, "İşlem Mesajı")
If cevap = vbYes Then
On Error Resume Next
Aranan = TextBox1.Value
Set ara = Sheets("Personel").Range("C:C").Find(Aranan, , xlValues, xlWhole)
Sheets("Personel").Cells(ara.Row, "C") = TextBox1.Value
Sheets("Personel").Cells(ara.Row, "B") = TextBox2.Value
Sheets("Personel").Cells(ara.Row, "U") = TextBox3.Value
Sheets("Personel").Cells(ara.Row, "V") = TextBox4.Value
Sheets("Personel").Cells(ara.Row, "S") = TextBox5.Value
Sheets("Personel").Cells(ara.Row, "Y") = TextBox9.Value
Sheets("Personel").Cells(ara.Row, "Z") = TextBox10.Value
Sheets("Personel").Cells(ara.Row, "X") = TextBox11.Value

Sheets("Personel").Cells(ara.Row, "AA") = TextBox13.Value
Sheets("Personel").Cells(ara.Row, "AB") = TextBox14.Value
Sheets("Personel").Range("XFD1").Value = "1"


MsgBox "verilerinizde Değişiklik yapıldı", , "UYARI"
UserForm6.Show
With Label6
.Visible = True
.ForeColor = &H8000000D
.Caption = "Veriler Güncellendi!!!"
End With


endtime = Now() + Seconds
Application.Wait (endtime + TimeValue("00:00:02"))
Label6.Visible = False

Else
Exit Sub
End If

Else

cevap = MsgBox("İkinci kez aktarmak üzeresiniz. Tekrar Aktarmak istiyor musunuz?", vbYesNo + vbExclamation, "İşlem Mesajı")
If cevap = vbYes Then
On Error Resume Next
Aranan = TextBox1.Value
Set ara = Sheets("Personel").Range("C:C").Find(Aranan, , xlValues, xlWhole)
Sheets("Personel").Cells(ara.Row, "C") = TextBox1.Value
Sheets("Personel").Cells(ara.Row, "B") = TextBox2.Value
Sheets("Personel").Cells(ara.Row, "U") = TextBox3.Value
Sheets("Personel").Cells(ara.Row, "V") = TextBox4.Value
Sheets("Personel").Cells(ara.Row, "S") = TextBox5.Value
Sheets("Personel").Cells(ara.Row, "Y") = TextBox9.Value
Sheets("Personel").Cells(ara.Row, "Z") = TextBox10.Value
Sheets("Personel").Cells(ara.Row, "X") = TextBox11.Value

Sheets("Personel").Cells(ara.Row, "AA") = TextBox13.Value
Sheets("Personel").Cells(ara.Row, "AB") = TextBox14.Value
Sheets("Personel").Range("XFD1").Value = "1"


MsgBox "verilerinizde Değişiklik yapıldı", , "UYARI"
UserForm6.Show
With Label6
.Visible = True
.ForeColor = &H8000000D
.Caption = "Veriler Güncellendi!!!"
End With


endtime = Now() + Seconds
Application.Wait (endtime + TimeValue("00:00:02"))
Label6.Visible = False

Else
Exit Sub
End If

End If


End Sub


Dener misiniz
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst