• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Uyarı verme

sirkülasyon

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
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?
 
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
 
Üstad
1 yazdı.
İkinci aktarmayı yapmıyor.
Ancak uyarı kısmını yapamadım
 
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.
Geri
Üst