• DİKKAT

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

Aktarma Hatası

Y

yavuz829

Katılım
8 Mart 2007
Mesajlar
582
Excel Vers. ve Dili
excel 2000 Türkçe
Merhaba arkadaşlar ekteki dosyamda verileri girip kayıt işlemi yapiyorum doğru çalışıyor. Değiştir butonunu çalıştırdığım zaman alındığı ürün hücresine veri aktarmiyor boş kaliyor. sayı yazdığım zaman aktariyor metin yazdığım zaman aktarmiyor. Bu konuda yardımlarınızı bekliyorum.
 

Ekli dosyalar

Bu satırı eskisi ile değiştirip deneyin.
Kod: 
ActiveCell.Offset(0, 2) = TextBox6.Text
 
Hocam yazdığınız kodu değiştirdim. Yine olmiyor kod hatası veriyor. Değiştirme yapmiyor.
 
Aşağıdaki kodu eskisiyle değiştirip deneyin.
Kod: 
Private Sub CommandButton5_Click()
Dim son, p As Integer
If TextBox7 = "" Then
MsgBox "Önce değiştirilecek veriyi seçmelisiniz", vbInformation
Exit Sub: End If
Application.ScreenUpdating = False
Cells(ListBox1.ListIndex + 5, 2).Select
ActiveCell = TextBox10
ActiveCell.Offset(0, 1) = TextBox6
ActiveCell.Offset(0, 2) = CDbl(TextBox7)
ActiveCell.Offset(0, 3) = CDbl(TextBox8)
ActiveCell.Offset(0, 4) = CDbl(TextBox8) * Val(TextBox7)
ActiveCell.Offset(0, 5) = CDbl(TextBox9)
ActiveCell.Offset(0, 6) = ActiveCell.Offset(0, 4) - CDbl(TextBox9)
'*****
son = Cells(65536, "h").End(xlUp).Row + 1
Range(Cells(son - 1, "e"), Cells(son - 1, "h")) = ""
Cells(son - 1, "h") = WorksheetFunction.Sum(Range("h4:h65536"))
Cells(son - 1, "g") = WorksheetFunction.Sum(Range("g4:g65536"))
Cells(son - 1, "f") = WorksheetFunction.Sum(Range("f4:f65536"))
Cells(son - 1, "e") = WorksheetFunction.Sum(Range("e4:e65536"))
Cells(son - 1, "d") = WorksheetFunction.Sum(Range("d4:d65536"))
'*****
ProgressBar3.Min = 0
ProgressBar3.Max = 1000
For p = 1 To 1000
DoEvents
ProgressBar3 = p
Next
ProgressBar3.Min = 0
'
ActiveWorkbook.Save
Application.ScreenUpdating = True
Unload Me
satis_takip.Show
End Sub
 
Çok teşekürler hocam değiştirdiğiniz kod ile oluyor. Ancak ekteki hatayı vermeden hiç bir işlemi yapmiyor.
 

Ekli dosyalar

  • adsız.jpg
    adsız.jpg
    90.3 KB · Görüntüleme: 11
Kodlarınızı incelerken dikkatimi çekmişti; form üzerinde, progressBar nesnesi yoktu bu yüzden hata veriyor olabilir.
 
Hamitcan Beyin dediği gibi kodlarınızda ProgressBar nesnesini bir kaç yerde kullanmışsınız bu nesneler olmadığı için hata uyarısı alıyorsunuz.

toolbox nesnesine microsoft progressbar control version 6.0 bunu bulup tikini işaretleyin ve userformunuza ekleyin
 
Hamitcan ve Halit3 hocalarım ikinize de çok teşekürler. Ben bu dosyayı formdan indirerek üzerinde kendime göre birşeyler eklemeye çalıştım onuda beceremedim. Kodlardan hiç anlamam ProgressBar nesnesinin ne olduğunu ve ne işe yaradığınıda bilmiyorum. Size zahmet olacak ekteki dosyamda işlem yaptığım zaman hata vermiyecek şekilde ayarlayabilirmisiniz. Teşekürler
 

Ekli dosyalar

Kodları, eskileri değiştirin. Yalnız belirteyim; kontrol etmedim. Hata verirse tekrar bakarız.
Kod: 
Private Sub CommandButton1_Click()
Dim i, p As Integer
On Error Resume Next
If TextBox2 = "" Then
MsgBox "Önce müşteri ismi girmelisiniz", vbInformation
Exit Sub: End If
Application.ScreenUpdating = False
Sheets("Sablon").Visible = True
For i = 3 To Sheets.Count
If Sheets(i).Name = TextBox2 Then
MsgBox "Bu isimli müşteri daha önce girilmiş", vbInformation
Exit Sub: End If: Next
Sheets("Sablon").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = TextBox2.Value
Range("a2") = Val(TextBox1)
Range("b2") = TextBox2
Range("d2") = TextBox3
Range("f2") = TextBox4
Range("g2") = TextBox5
'*****
'ProgressBar1.Min = 0
'ProgressBar1.Max = 1000
'For p = 1 To 1000
'DoEvents
'ProgressBar1 = p
'Next
'ProgressBar1.Min = 0
'*****
Sheets("Sablon").Visible = False
Application.ScreenUpdating = True
Unload Me
satis_takip.Show
End Sub
Private Sub CommandButton2_Click()
Dim sira, son, p As Integer
If TextBox6 = "" Then
MsgBox "Aldığı ürünü boş geçemezsiniz. Açıklama yazınız.", vbInformation
Exit Sub: End If
If TextBox7 = "" Then
MsgBox "Miktarı boş geçemezsiniz rakam yazınmeyiniz. Yazılacak rakam yoksa 0 (sıfır) rakamını yazınız.", vbInformation
Exit Sub: End If
If TextBox8 = "" Then
MsgBox "Fiyatı boş geçmeyiniz. Rakam Yazınız. Yazılacak rakam yoksa 0 (sıfır) rakamını yazınız.", vbInformation
Exit Sub: End If
If TextBox9 = "" Then
MsgBox "Tahsilatı boş geçmeyiniz. Tahsilata yazılacak rakam yoksa 0 (sıfır) yazınız.", vbInformation
Exit Sub: End If
Application.ScreenUpdating = False
son = Cells(65536, "a").End(xlUp).Row + 1
Cells(son, "b") = TextBox10
Cells(son, "c") = TextBox6
Cells(son, "d") = Val(TextBox7)
Cells(son, "e") = CDbl(TextBox8)
Cells(son, "f") = Val(TextBox7) * CDbl(TextBox8)
Cells(son, "g") = CDbl(TextBox9)
Cells(son, "h") = Cells(son, "f") - CDbl(TextBox9)
'*****
For sira = 4 To Cells(65536, "b").End(xlUp).Row
Cells(sira, "a") = sira - 3
Next
'*****
son = Cells(65536, "h").End(xlUp).Row + 1
Cells(son, "h") = WorksheetFunction.Sum(Range("h4:h65536"))
Cells(son, "g") = WorksheetFunction.Sum(Range("g4:g65536"))
Cells(son, "f") = WorksheetFunction.Sum(Range("f4:f65536"))
Cells(son, "e") = WorksheetFunction.Sum(Range("e4:e65536"))
Cells(son, "d") = WorksheetFunction.Sum(Range("d4:d65536"))
'*****
'ProgressBar3.Min = 0
'ProgressBar3.Max = 1000
'For p = 1 To 1000
'DoEvents
'ProgressBar3 = p
'Next
'ProgressBar3.Min = 0

'*****
ActiveWorkbook.Save
Application.ScreenUpdating = True
Unload Me
satis_takip.Show
End Sub
Private Sub CommandButton3_Click()
Dim i, p, sonr, son As Integer
Application.ScreenUpdating = False
Sheets("1-Rapor").Range("a2:c1000") = Empty
For i = 3 To Sheets.Count
sonr = Sheets("1-Rapor").Cells(65536, "a").End(xlUp).Row + 1
son = Sheets(i).Cells(65536, "ı").End(xlUp).Row
Sheets("1-Rapor").Cells(sonr, "a") = Sheets(i).Range("b2")
Sheets("1-Rapor").Cells(sonr, "b") = Sheets(i).Cells(son, "h")
Sheets("1-Rapor").Cells(sonr, "c") = Sheets(i).Cells(son, "ı")
Next
'*****
'ProgressBar4.Min = 0
'ProgressBar4.Max = 1000
'For p = 1 To 1000
'DoEvents
'ProgressBar4 = p
'Next
'ProgressBar4.Min = 0

Sheets("1-Rapor").Select
Application.ScreenUpdating = True
Unload Me
End Sub
Private Sub CommandButton4_Click()
Dim p As Integer
If ListBox2.ListIndex < 0 Then
MsgBox "Silmek için bir müşteri seçiniz", vbInformation
Exit Sub: End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
'*****
'ProgressBar5.Min = 0
'ProgressBar5.Max = 1000
'For p = 1 To 1000
'DoEvents
'ProgressBar5 = p
'Next
'ProgressBar5.Min = 0
Application.ScreenUpdating = True
Unload Me
satis_takip.Show
End Sub
Private Sub CommandButton5_Click()
Dim son, p As Integer
If TextBox7 = "" Then
MsgBox "Önce değiştirilecek veriyi seçmelisiniz", vbInformation
Exit Sub: End If
Application.ScreenUpdating = False
ActiveCell = TextBox10
ActiveCell.Offset(0, 1) = TextBox6
ActiveCell.Offset(0, 2) = CDbl(TextBox7)
ActiveCell.Offset(0, 3) = CDbl(TextBox8)
ActiveCell.Offset(0, 4) = CDbl(TextBox8) * Val(TextBox7)
ActiveCell.Offset(0, 5) = CDbl(TextBox9)
ActiveCell.Offset(0, 6) = ActiveCell.Offset(0, 4) - CDbl(TextBox9)
'*****
son = Cells(65536, "h").End(xlUp).Row + 1
Range(Cells(son - 1, "e"), Cells(son - 1, "h")) = ""
Cells(son - 1, "h") = WorksheetFunction.Sum(Range("h4:h65536"))
Cells(son - 1, "g") = WorksheetFunction.Sum(Range("g4:g65536"))
Cells(son - 1, "f") = WorksheetFunction.Sum(Range("f4:f65536"))
Cells(son - 1, "e") = WorksheetFunction.Sum(Range("e4:e65536"))
Cells(son - 1, "d") = WorksheetFunction.Sum(Range("d4:d65536"))
'*****
'ProgressBar3.Min = 0
'ProgressBar3.Max = 1000
'For p = 1 To 1000
'DoEvents
'ProgressBar3 = p
'Next
'ProgressBar3.Min = 0

ActiveWorkbook.Save
Application.ScreenUpdating = True
Unload Me
satis_takip.Show
End Sub
Private Sub CommandButton6_Click()
Dim p, son As Integer
If TextBox7 = "" Then
MsgBox "Öce Silinecek veriyi seçmelisiniz", vbInformation
Exit Sub: End If
Application.ScreenUpdating = False
ActiveCell.EntireRow.Delete Shift:=xlUp
'*****
son = Cells(65536, "ı").End(xlUp).Row + 1
Range(Cells(son - 1, "d"), Cells(son - 1, "ı")) = ""
Cells(son - 1, "h") = WorksheetFunction.Sum(Range("h4:h65536"))
Cells(son - 1, "g") = WorksheetFunction.Sum(Range("g4:g65536"))
Cells(son - 1, "f") = WorksheetFunction.Sum(Range("f4:f65536"))
Cells(son - 1, "e") = WorksheetFunction.Sum(Range("e4:ef65536"))
Cells(son - 1, "d") = WorksheetFunction.Sum(Range("d4:d65536"))
'*****
'ProgressBar3.Min = 0
'ProgressBar3.Max = 1000
'For p = 1 To 1000
'DoEvents
'ProgressBar3 = p
'Next
'ProgressBar3.Min = 0

ActiveWorkbook.Save
Application.ScreenUpdating = True
Unload Me
satis_takip.Show
End Sub
Private Sub ListBox1_Click()
Dim p As Integer
'*****
Application.ScreenUpdating = False
'ProgressBar2.Min = 0
'ProgressBar2.Max = 1000
'For p = 1 To 1000
'DoEvents
'ProgressBar2 = p
'Next
'ProgressBar2.Min = 0
Sheets(ListBox1.Text).Select
Application.ScreenUpdating = True
Unload Me
satis_takip.Show
End Sub
Private Sub ListBox2_Click()
Sheets(ListBox2.Text).Select
End Sub
Private Sub ListBox3_Click()
Application.ScreenUpdating = False
Cells(ListBox3.ListIndex + 4, 2).Select
TextBox10 = ActiveCell
TextBox6 = ActiveCell.Offset(0, 1)
TextBox7 = ActiveCell.Offset(0, 2)
TextBox8 = ActiveCell.Offset(0, 3)
TextBox9 = ActiveCell.Offset(0, 5)
Application.ScreenUpdating = True
End Sub



Private Sub UserForm_Activate()
Application.DisplayFormulaBar = False
For Each menuiptal In CommandBars
menuiptal.Enabled = False
Next
End Sub
Private Sub UserForm_Initialize()
Dim i, sat As Integer
Application.ScreenUpdating = False
For i = 3 To Sheets.Count
ListBox1.AddItem Sheets(i).Name
Next
'*****
For i = 3 To Sheets.Count
ListBox2.AddItem Sheets(i).Name
Next
'*****
'*****
ListBox3.Clear
ListBox3.ColumnCount = 2
ListBox3.ColumnWidths = "30,75"
For sat = 4 To Cells(65536, "a").End(xlUp).Row
ListBox3.AddItem
ListBox3.List(s, 0) = Cells(sat, "a")
ListBox3.List(s, 1) = Cells(sat, "c")
s = s + 1
Next
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.DisplayFormulaBar = True
For Each menuac In CommandBars
menuac.Enabled = True
Next
End Sub
 
İkinizede çok çok teşekürler ellerinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst