AccessTr.neT

Herkese Merhaba
Veri sayfasında A:N  aralığında olan veriler için
Userform1 açıldığında TASARI sayfasına kaydetmek şartı ile
Veri sayfasından veriler çekilerek tasarı sayfasına kaydedilecek

Misal userform1 comboBoxlarda
A sütününa adı seçildiğinde
C sütununa tahsili seçildiğinde
G sütununa sicili seçildiğinde

Sayfayı hazırla butonuna tıklayınca 1. Satırdaki başlıkları ile beraber veri sayfasındaki sütunların tasarı sayfasına seçilen sıra ile kaydedilmesini istiyorum.

Örneğin
Userform1  comboBoxlarda A sütununa rütbesi  seçilirse sayfayı hazırla butonuna basılırsa tasarı sayfası  A sütununa 1. Satira Comboboxtaki değer olan "Rütbesi"  yazdıktan sonra  A sütünü 2. Satırdan itibaren tüm rütbeleri sırayla getirmesi gerekiyor

Comboboxta hangi sütunda hangi başlık seçilirse başlığı ile beraber tasarı sayfasına aktarmasını istiyorum.

Yardımcı olabilecek olan varsa çok sevinirim.

bir kaç ufak değişiklik yaptım mesela açılışta comboları doldururken o kadar koda gerek yok aslında
referanslardan ADO eklenecek
listeye ekleme kodu:

Function listeDoldur() As Variant

Dim BsDizi(0 To 13, 1) As Variant

TmpDz = Array("S.N.", "Sicili", "Adı", "Soyadı", "Rütbesi", "Bürosu", "TC Kimlik No", "Kan Grubu", "Cep Tel", "Dahili", "Tahsili", "Cinsiyet", "Diğer", "Kodu")

x = 0

For Each Itm In TmpDz

    BsDizi(x, 0) = x + 1

    BsDizi(x, 1) = Itm

    x = x + 1

Next Itm

listeDoldur = BsDizi

End Function

Userform  başlatma kodu

Private Sub UserForm_Initialize()

For x = 1 To 14

    Controls("ComboBox" & x).ColumnCount = 2

    Controls("ComboBox" & x).ColumnWidths = "0"

    Controls("ComboBox" & x).List = listeDoldur

Next x

End Sub

sayfa hazırlama kodu

Private Sub CommandButton7_Click()



Dim ADO_RS As ADODB.Recordset

Dim ADO_CN As ADODB.Connection

AlanSec = ""

AlanAd = ""

For x = 1 To 14

  If Not IsNull(Controls("ComboBox" & x)) Then

        AlanSec = AlanSec & ",[F" & Controls("ComboBox" & x).Value & "]"

        AlanAd = AlanAd & "," & Controls("ComboBox" & x).Column(1) 'Range("F4").Resize(UBound(ArrayToPaste, 1)

  End If

Next x

AlanSec = Mid(AlanSec, 2)

AlanAd = Mid(AlanAd, 2)

If Len(AlanSec & "") = 0 Then Exit Sub

Sql = "SELECT " & AlanSec & " " & _

      "FROM [veri$A2:N]"



Set ADO_RS = New ADODB.Recordset

Set ADO_CN = New ADODB.Connection



ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _

                          ";extended properties=""excel 8.0;Imex=1;hdr=no"""

ADO_CN.Open

ADO_RS.Open Sql, ADO_CN, 3, 1



ThisWorkbook.Sheets("TASARI").Cells.Clear

ThisWorkbook.Sheets("TASARI").Range("A1").Resize(1, UBound(Split(AlanAd, ",")) + 1) = Split(AlanAd, ",")

ThisWorkbook.Sheets("TASARI").Range("A2").CopyFromRecordset ADO_RS

Debug.Print AlanAd, UBound(Split(AlanAd, ","))

ADO_RS.Close

ADO_CN.Close

End Sub

Berduş Hocam kod şöyle olmalıydı
Misal J sütununu sadece rütbe diye seçince J ye rütbeyi yazmalı

Kod bu hali ile tasarı sayfasındaki ilk boş satırdan devam ediyor yerleştirmeye

Mesala tasarı sayfası abc sütunları dolu Userformda N sütünü için comboboxa adı seviyorum boş olan D sütununa yazıyor.
Halbuki arada boşluk olsa da N sütununa kaydetmeliydi

(13/04/2021, 13:18)hayalibey yazdı: [ -> ]Örneğin
Userform1  comboBoxlarda A sütununa rütbesi  seçilirse sayfayı hazırla butonuna basılırsa tasarı sayfası  A sütununa 1. Satira Comboboxtaki değer olan "Rütbesi"  yazdıktan sonra  A sütünü 2. Satırdan itibaren tüm rütbeleri sırayla getirmesi gerekiyor

ama siz böyle demişsiniz. A'ya rütbesi seçmişsem rütbesi gelsin diye

Hocam aslında anlatmak istediğim şey şöyle.
Userformda Labellerin altındaki comboBoxlar tasarı sayfasındaki sütunlara bağlanacak.

Hangi comboboxta hangi değer seçilirse tasarı sayfasında kendi sutunu altına gelecek ilgili değer

Misal A sütünü dolu B C boş D dolu olabilir .
Her sütün kendi comboBoxunda seçilen veri türünü gösterecek

buton kodunu aşağıdaki gibi düzenleyip dener misiniz

ThisWorkbook.Sheets("TASARI").Cells.Clear '

For x = 1 To 14

  If Not IsNull(Controls("ComboBox" & x)) Then  Sheets("veri").Columns(Controls("ComboBox" & x)).Copy Destination:=Sheets("TASARI").Columns(x)

Next x