AccessTr.neT

Tam Versiyon: etiketleri alt alta hizalamak
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2
Modülü aşağıdaki ile değiştiriniz



Option Compare Database

Option Explicit



Public Sub erya()
Dim pozsayi As Integer
Dim sayi As Integer
Dim olcu As String
Dim i, a As Integer
Dim sorgu As String
Dim sorgusayi As Long
Dim devirsorgu  As Recordset
Dim frm As Form
Dim ctllabel, ctlline As Control
''''''''''''''''''''''''''''''''''''''''''''''''her yeni formda eski form silinecek
Set frm = CreateForm ' yeni form olustur
Set devirsorgu = Application.CurrentDb.OpenRecordset("SELECT * FROM tablohareket")
devirsorgu.MoveLast: devirsorgu.MoveFirst

Do
   For a = 1 To devirsorgu.RecordCount
       For i = 1 To devirsorgu!camsayi
       
       Set ctllabel = CreateControl(frm.Name, acLabel, , , " poz " & devirsorgu!poz & "-" & i)
       
       ctllabel.Name = "poz" & a & "-" & i
           With ctllabel
               .FontSize = 12
               .BorderColor = vbRed
               .BorderStyle = 1
                   If a = 1 Then
                      .Move (i * 1000 - 800), (80), 1000, 1600
                   Else
                     .Move ((i * 1000) - 800), ((a - 1) * 1600 + 80), 1000, 1600
                   End If
           End With
       Next
   devirsorgu.MoveNext
   Next
Loop Until devirsorgu.EOF

   Forms(frm.Name).NavigationButtons = False  'gezinti dügmeleri kapalı
   Forms(frm.Name).RecordSelectors = False    'kayıt seçici kapalı
   Forms(frm.Name).DividingLines = False      'kayıt bölücü kapalı
   DoCmd.Close acForm, frm.Name, acSaveYes
'    DoCmd.OpenForm frm.Name, acNormal
   devirsorgu.Close
   Set devirsorgu = Nothing

End Sub


Ayrıca, bu kod 20. kayıttan sonra çalışmaz. Form yüksekliği "31680" twips değerinden (55,873cm) büyük olamaz.
selam
her iki modülde harika olmuş çalışıyor tam istediğim gibi ellerinize sağlık

eğer müsaade ederseniz bir sıkıntım daha var
ekteki resimde de görülebilir

alttaki resimdeki gibi her sıra çizime (kırmızı olanlar)
yeni 2 adet label ekleyip(mavi olanlar)
1.üstte 2.sağ yana yaslamam gerekli

labeli ekliyorum ama yönlendirmeyi çözemedim


Kod:
Option Compare Database

Option Explicit



Public Sub erya()
Dim pozsayi As Integer
Dim sayi As Integer
Dim olcu As String
Dim i, a, b As Integer
Dim sorgu As String
Dim sorgusayi As Long
Dim devirsorgu  As Recordset
Dim frm As Form
Dim ctllabel, ctlline As Control
''''''''''''''''''''''''''''''''''''''''''''''''her yeni formda eski form silinecek
Set frm = CreateForm ' yeni form olustur
Set devirsorgu = Application.CurrentDb.OpenRecordset("SELECT * FROM tablohareket")
devirsorgu.MoveLast: devirsorgu.MoveFirst

Do
  For a = 1 To devirsorgu.RecordCount
      For i = 1 To devirsorgu!camsayi
     
      Set ctllabel = CreateControl(frm.Name, acLabel, , , " poz " & devirsorgu!poz & "-" & i)
     
      ctllabel.Name = "poz" & a & "-" & i
          With ctllabel
              .FontSize = 12
              .BorderColor = vbRed
              .BorderStyle = 1
                  If a = 1 Then
                     .Move (i * 1000 - 800), (80), 1000, 1600
                  Else
                    .Move ((i * 1000) - 800), ((a - 1) * 1600 + 80), 1000, 1600
                  End If
          End With
      Next
      For b = 1 To devirsorgu.RecordCount
Set ctllabel = CreateControl(frm.Name, acLabel, , , IIf(b = 1, devirsorgu!genislik, devirsorgu!yukseklik))
ctllabel.Name = IIf(b = 1, "Genişlik-" & a & b, "Yükseklik-" & a & b)  'etiket adlarını sırala
With ctllabel
.TextAlign = 2
If b = 1 Then
'                    left   top              width  height
.Move (i * 10) + (i) * 50, (10 * i), i * (750) + (250), 250

Else
'                            left                           top  width height
.Move (i * 1000 - 800) + (i) * 50, ((a - 1) * 1600 + 170) + (500), 250, 1600
.Vertical = True
End If
End With
Next

devirsorgu.MoveNext
Next
Loop Until devirsorgu.EOF

devirsorgu.Close
Set devirsorgu = Nothing

Forms(frm.Name).NavigationButtons = False  'gezinti dügmeleri kapalı
Forms(frm.Name).RecordSelectors = False    'kayıt seçici kapalı
Forms(frm.Name).DividingLines = False      'kayıt bölücü kapalı

DoCmd.Close acForm, frm.Name, acSaveYes
DoCmd.OpenForm "form1", acDesign



End Sub
[Resim: do.php?img=5154]
sayın aydin3838,

siz de takdir edersiniz ki,Site Kuralları gereği;

Alıntı:selam
her iki modülde harika olmuş çalışıyor tam istediğim gibi ellerinize sağlık

eğer müsaade ederseniz bir sıkıntım daha var

ifadenizden de yola çıkıldığında,konuya yönelik olarak yapılan paylaşımların olumlu olduğu ve sorununuzun çözüldüğü görülmektedir.

bu nedenle,ilgili bu konunuzun Cevaplanmış Sorular kategorisi içerisine taşınması ve diğer sorununuza dair yeni bir konu açmak ve bu konunuzda uygun anlatımda bulunmak sureti ile ayrıca örnek uygulamanızı da yeni konunuza dahil ederek,hem bu konunuzun harici diğer sorunlar ile mesaj yoğunluğuna maruz kalmamasını hem de yeni sorununuza dair benzer soruna maruz kalıp araştırma yapacak diğer üyelerimizin de konunuza alternatif bir inceleme yapmalarına imkan sağlamış olacaksınızdır.teşekkürler.

bilginize...iyi çalışmalar,saygılar.
sayın atoz112

sorum 2 aşamadan oluşmakta bu soruyu cevaplanmış sorulara taşırsanız sorum yarım kalmış olur ve ben yine benzer bir başlık ile aynı sorunun benzerini yeniden sormuş olacağım
takdir sizin

kolay gelsin
(31/10/2015, 20:13)aydın3838 yazdı: [ -> ]sayın atoz112

sorum 2 aşamadan oluşmakta bu soruyu cevaplanmış sorulara taşırsanız sorum yarım kalmış olur ve ben yine benzer bir başlık ile aynı sorunun benzerini yeniden sormuş olacağım
takdir sizin

kolay gelsin

Access Soruları ve Cevapları bölümüne uygun konu başlığı ile örnek uygulamanızı ekleyerek yeni konu açınız.
Sayfalar: 1 2