Yardım Çoklu veri gönderimi

harunonline · 3 Ara 2018

Merhaba Arkadaşlar,

Ekteki dosyada liste sayfasında teklif oluştur makrosu ile teklif sayfasına veri gönderimi
yapmaktayız. Burda tek tek seçim yaparak her defasında bir veri gönderimi yapıyoruz.
Burda yapmak istediğimiz 5 veya 6 toplu seçim yaparak yada bir aralık belirleyerek
birden fazla veriyi göndermek istiyoruz. Aynı işlemi başka sayfalardaki makrolarda da
kullanacağız.

Şimdiden ilginiz için teşekkürler.

Harun PALABIYIK

Murat OSMA · 3 Ara 2018

Merhabalar,
TeklifOlustur prosedürünü bu şekilde değiştirip deneyiniz..

PHP:

Sub TeklifOlustur()
    Dim cevap As Integer
    Sayfa8.Range("A22:X41").Value = ""
    sat = 22: s = Selection.Row
    For i = 1 To Selection.Count
        Sayfa8.Cells(sat, "A") = Cells(s, "C").Value
        Sayfa8.Cells(sat, "F") = Cells(s, "E").Value
        Sayfa8.Cells(sat, "P") = Cells(s, "F").Value
        Sayfa8.Cells(sat, "X") = Range("J" & s).Value & "Gr Karton / " & Range("N" & s).Value & " Sıvama"
        Cells(s, "C").Font.Size = 13
        Cells(s, "C").Font.Bold = True
        sat = sat + 2
        s = s + 1
    Next i
    Sheets("Teklif").Select
    cevap = MsgBox("BU TEKLİFİ YAZDIRMAK İSTEDİĞİNİZDEN EMİNMİSİNİZ?", vbQuestion + vbYesNo, "Qustion")
    If cevap = vbYes Then
        ActiveWindow.SelectedSheets.PrintOut copies:=1 'yaz Makro
            Else
        Exit Sub
    End If
End Sub

Sonuç:

harunonline · 3 Ara 2018

Butona tıkladığımızda yazdırmak istediğimiz satırlar farklı farklı sıralarda olabiliyor.
Seçmek istediğimiz satırları sorabilir mi. ve teklifde 10 sıra var yanlışlıkla 10dan fazla
yazdırmayı engelleyebilirmiyiz.

teşekkürler

Murat OSMA · 3 Ara 2018

Kodları bu şekilde revize edebilirsiniz..
10'dan fazla hücre seçtirmez ve hangi hücreleri seçerseniz o hücreler teklif sayfasına yazdırılır.

PHP:

Sub TeklifOlustur()
    Dim cevap%, sat%, i%, al
    Sayfa8.Range("A22:X41").Value = ""
    If Selection.Count > 10 Then
        MsgBox "10 Satırdan Fazla Veri Seçtiniz.", vbCritical, "UYARI!"
        Exit Sub
    End If
    sat = 22: al = Split(Selection.Address, "$C$")
    For i = 1 To Selection.Count
        Sayfa8.Cells(sat, "A") = Range("C" & Val(al(i))).Value
        Sayfa8.Cells(sat, "F") = Range("E" & Val(al(i))).Value
        Sayfa8.Cells(sat, "P") = Range("F" & Val(al(i))).Value
        Sayfa8.Cells(sat, "X") = Range("J" & Val(al(i))).Value & "Gr Karton / " & _
        Range("N" & Val(al(i))).Value & " Sıvama"
        Range("C" & Val(al(i))).Font.Size = 13
        Range("C" & Val(al(i))).Font.Bold = True
        sat = sat + 2
    Next i
    Sheets("Teklif").Activate
    cevap = MsgBox("BU TEKLİFİ YAZDIRMAK İSTEDİĞİNİZDEN EMİNMİSİNİZ?", vbQuestion + vbYesNo, "Qustion")
    If cevap = vbYes Then
        ActiveWindow.SelectedSheets.PrintOut copies:=1 'yaz Makro
            Else
        Exit Sub
    End If
    i = Empty: sat = Empty: cevap = Empty
End Sub

harunonline · 3 Ara 2018

biz ikisinin arası birşey istiyoruz. Listeden mause ile seçim yaparak değilde teklif oluştur
butonunu tıklayınca uyarı menüsünde hangi maliyetleri yazdırmak istiyorsunuz gibi bir uyarı
sonrası mausela komple 10 tane seçilebilmeli veya kaçtane yazdıracaksak tek tek seçilmeli

teşekkürler.

harunonline · 11 Ara 2018

Merhaba,

Aşağıdaki kod yapısında makro çalıştığında liste sayfasında c sütünundaki seçimi yaparak üretime ilgili alanları göndermekte
ama bunu tek tek yapabiliyoruz. Makro çalığtığında virgül veya başka bir ayırım ile seçimlerimizi yapıp nasıl gönderebiliriz.
Üretimde her defasında 2.satıra atmakta eski kayıtlarımız alta doğru sıralanmaktadır.

İyi Çalışmalar,

PHP:

Sub uretimeal()



Dim cevap As Integer

Sheets("LISTE").Select

Set işemrino = Application.InputBox( _

Prompt:="ÜRETİME ALMAK İSTEDİĞİNİZ MALİYET NUMARASINI BELİRTİNİZ!", _

Type:=8)

işemrino.Font.Size = 13

işemrino.Font.Bold = True

     cevap = MsgBox(işemrino_Offset(0, 0) & " MALİYET NUMARALI " & işemrino_Offset(0, 1) & _

    "'E AİT " & işemrino_Offset(0, 2) & " " & işemrino_Offset(0, 3) & " ADET  ÜRETİME ALINCAKTIR?", vbQuestion + vbYesNo, "Question")



If cevap = vbYes Then



Sheets("URETIM").Select





Range("a2:br1000").Cut Range("a3")



Cells(2, 1) = Range("a3") + 1

Cells(2, 2) = işemrino_Offset(0, -1) 'Maliyet Tarihi

Cells(2, 3) = işemrino_Offset(0, 0) 'Maliyet No

Cells(2, 4) = işemrino_Offset(0, 1) 'Sipariş No

Cells(2, 5) = işemrino_Offset(0, 2) 'Stok Kodu

Cells(2, 6) = işemrino_Offset(0, 3) 'Ürün Kodu

Cells(2, 9) = işemrino_Offset(0, 4) 'Müşteri

Cells(2, 10) = işemrino_Offset(0, 5) 'Marka

Murat OSMA · 11 Ara 2018

Bir araya geldiğimizde tüm işlemleri sırasıyla gerçekleştiririz.

İyi akşamlar.

Yardım Çoklu veri gönderimi

Daha fazla seçenek

harunonline

Ekli dosyalar

Murat OSMA

harunonline

Murat OSMA

harunonline

harunonline

Murat OSMA