DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
20 Kasım 2017
Aşağıdaki kodları ilgili sayfa ismine sağ tıklayıp Kod Görüntüle deyince çıkan sayfaya yapıştırıp deneyin :
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target <> "" Then
Target.Offset(0, -1) = Target.Row - 1
Target.Offset(0, -1).Font.Color = vbRed
End If
End Sub
Siz çözümü word üzerinde mi bekliyorsunuz excel üzerinde mi ?
Nerede neyin olması gerektiğini siz biliyorsunuz ancak çözüm verebilecek kişiler bunu yükleyeceğiniz bir örnekte görebilir.
http://www.filebig.net/files/K8yiTKbmAQ Dosya Buwww.filebig.net adresine yükleyip sitenin verdiği linki buraya yapıştırınız
Çeki listesindeki 10. ve 23. Satırlara Toplam koli Adetini 1 den başlayarak ek deki adet için yazıyorum 305'e kadar yazmayı ve 1/1 yazan yere de Ürün koli b6-b7-b8 de yazan koli adetleri (örnek 94/1 - 94/2 - 94/3 - 94/4 )Merhaba,
Eklediğiniz dosyada hangi hücreye ne yazmasnı istiyorsunuz?
http://www.filebig.net/files/fWru8zCt9eSayfa1 C2 hücresinde 305 yazıyor.
2-5 Yaş sayfasında C10-N10-C23-N23 hücrelerinde "1/" yazıyor.
Yazdırma anında bu hücrelerde nasıl bir görüntü olması gerekiyor.
Aşağıdaki gibi sırayla etiketleri dolduracak mı?
1/1
1/2
1/3
1/4
....
1/305
Sub etiket()
Set s1 = Sheets("2-5 Yaş ")
Set s2 = Sheets("Sayfa1")
a = 0
For koli = 6 To 18
If s2.Cells(koli, "B") > 0 Then
toplam = s2.Cells(koli, "B")
For yaz = 1 To toplam Step 4
s1.[C10] = toplam
s1.[E10] = yaz
s1.[G10] = a
a = a + 1
If yaz + 1 <= toplam Then
s1.[N10] = toplam
s1.[P10] = yaz + 1
s1.[R10] = a
a = a + 1
Else
s1.[N10] = ""
s1.[P10] = ""
s1.[R10] = ""
End If
If yaz + 2 <= toplam Then
s1.[C23] = toplam
s1.[E23] = yaz + 2
s1.[G23] = a
a = a + 1
Else
s1.[C23] = ""
s1.[E23] = ""
s1.[G23] = ""
End If
If yaz + 3 <= toplam Then
s1.[N23] = toplam
s1.[P23] = yaz + 3
s1.[R23] = a
a = a + 1
Else
s1.[N23] = ""
s1.[P23] = ""
s1.[R23] = ""
End If
s2.PrintOut
Next
End If
Next
End Sub
Aşağıdaki makroyu bir modüle kopyalayıp deneyin.
4'ün katı olmayan koli sayılarında bazı etiketler boş kalacaktır, boş kalanların yerine diğer kolinin bilgilerini yazdıramadım. Aslında yazdırılabilir, şöyle ki, makro önce başka bir sayfada tüm etiket bilgilerini her satırda bir tane olacak şekilde listeler, sonra da bu listeden etiket sayfasına bilgileri alır. isterseniz o şekilde düzenlenebilir.
Şimdiki hali şöyle aşağıda. Yalnız çalıştırmadan önce kağıt israfı olmaması için tablonuzda basılacak etiket sayısını azaltarak deneyin:
PHP:Sub etiket() Set s1 = Sheets("2-5 Yaş ") Set s2 = Sheets("Sayfa1") a = 0 For koli = 6 To 18 If s2.Cells(koli, "B") > 0 Then toplam = s2.Cells(koli, "B") For yaz = 1 To toplam Step 4 s1.[C10] = toplam s1.[E10] = yaz s1.[G10] = a a = a + 1 If yaz + 1 <= toplam Then s1.[N10] = toplam s1.[P10] = yaz + 1 s1.[R10] = a a = a + 1 Else s1.[N10] = "" s1.[P10] = "" s1.[R10] = "" End If If yaz + 2 <= toplam Then s1.[C23] = toplam s1.[E23] = yaz + 2 s1.[G23] = a a = a + 1 Else s1.[C23] = "" s1.[E23] = "" s1.[G23] = "" End If If yaz + 3 <= toplam Then s1.[N23] = toplam s1.[P23] = yaz + 3 s1.[R23] = a a = a + 1 Else s1.[N23] = "" s1.[P23] = "" s1.[R23] = "" End If s2.PrintOut Next End If Next End Sub
Sub etiket()
Set s1 = Sheets("2-5 Yaş ")
Set s2 = Sheets("Sayfa1")
a = 0
For koli = 6 To 18
If s2.Cells(koli, "B") > 0 Then
s1.[X2] = s2.Cells(koli, "A")
toplam = s2.Cells(koli, "B")
For yaz = 1 To toplam Step 4
s1.[C10] = toplam
s1.[E10] = yaz
s1.[G10] = a
a = a + 1
If yaz + 1 <= toplam Then
s1.[N10] = toplam
s1.[P10] = yaz + 1
s1.[R10] = a
a = a + 1
Else
s1.[N10] = ""
s1.[P10] = ""
s1.[R10] = ""
End If
If yaz + 2 <= toplam Then
s1.[C23] = toplam
s1.[E23] = yaz + 2
s1.[G23] = a
a = a + 1
Else
s1.[C23] = ""
s1.[E23] = ""
s1.[G23] = ""
End If
If yaz + 3 <= toplam Then
s1.[N23] = toplam
s1.[P23] = yaz + 3
s1.[R23] = a
a = a + 1
Else
s1.[N23] = ""
s1.[P23] = ""
s1.[R23] = ""
End If
s2.PrintOut
Next
End If
Next
End Sub
Emeğinize Sağlık Gayet güzel Çalıştı...Anladığım kadarıyla X2 hücresine bağlı olarak formülleriniz çalışıyor. Bu durumda kodu aşağıdakiyle değiştirmelisiniz:
PHP:Sub etiket() Set s1 = Sheets("2-5 Yaş ") Set s2 = Sheets("Sayfa1") a = 0 For koli = 6 To 18 If s2.Cells(koli, "B") > 0 Then s1.[X2] = s2.Cells(koli, "A") toplam = s2.Cells(koli, "B") For yaz = 1 To toplam Step 4 s1.[C10] = toplam s1.[E10] = yaz s1.[G10] = a a = a + 1 If yaz + 1 <= toplam Then s1.[N10] = toplam s1.[P10] = yaz + 1 s1.[R10] = a a = a + 1 Else s1.[N10] = "" s1.[P10] = "" s1.[R10] = "" End If If yaz + 2 <= toplam Then s1.[C23] = toplam s1.[E23] = yaz + 2 s1.[G23] = a a = a + 1 Else s1.[C23] = "" s1.[E23] = "" s1.[G23] = "" End If If yaz + 3 <= toplam Then s1.[N23] = toplam s1.[P23] = yaz + 3 s1.[R23] = a a = a + 1 Else s1.[N23] = "" s1.[P23] = "" s1.[R23] = "" End If s2.PrintOut Next End If Next End Sub
Yusuf Hocam Dediğin gibi 4 ün katları olmayınca Salaklaşıyor.Aşağıdaki makroyu bir modüle kopyalayıp deneyin.
4'ün katı olmayan koli sayılarında bazı etiketler boş kalacaktır, boş kalanların yerine diğer kolinin bilgilerini yazdıramadım. Aslında yazdırılabilir, şöyle ki, makro önce başka bir sayfada tüm etiket bilgilerini her satırda bir tane olacak şekilde listeler, sonra da bu listeden etiket sayfasına bilgileri alır. isterseniz o şekilde düzenlenebilir.
Şimdiki hali şöyle aşağıda. Yalnız çalıştırmadan önce kağıt israfı olmaması için tablonuzda basılacak etiket sayısını azaltarak deneyin:
Dosyayı İndiremiyorum yardımcı olurmusunuz...Bir önceki mesajımda belirttiğim üçüncü bir sayfa kullanıp yazdırma işini hallettim. Ekli dosyayı inceleyiniz. Dosyanın bu halinde artık X2 hücresine gerek yok. Dosyanızdaki düşeyara formüllerine de gerek yok. Bastırılacak her etiket Sayfa2'ye ayrı satırda kaydediliyor ve bu liste kullanılarak etiket sayfanıza bilgiler alınıp yazdırma işlemi yapılıyor. Toplam koli sayısı 4'ün katı değilse, eksik etiketler boş kalıyor.
https://drive.google.com/file/d/1IidsDADkNfhQ_z62L14-2XFspIHuoIYP/view?usp=sharing