[Yardım]  Yeni sayfadaki hücreye veri aktar

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Yeni sayfadaki hücreye veri aktar

İleti#1)  massgrave » 10 Ağu 2019 07:48

Butona tıklandığında;
TextBox1.Text değerini yeni excel sayfası açıp (dışa aktar tarzında) Yeni excel sayfasının B3 hücresine yaz.
B2 hücresine ise "DENEME" yaz.
İşlemi yapan kod için yardım eder misiniz?

Örnek Listbox Aktarma Kodu:
Kod: Tümünü seç
Private Sub Image13_Click()

YesNo = MsgBox("EVET - HAYIR?", vbYesNo + vbExclamation, "AKTAR")
Select Case YesNo
Case vbYes
Dim i As Integer
    Dim xlApp As Excel.Application
    Dim xlSh As Excel.Worksheet

    Set xlApp = New Excel.Application
    xlApp.Visible = True
    xlApp.Workbooks.Add

    Set xlSh = xlApp.Workbooks(1).Worksheets(1)
     For i = 1 To Me.ListBox1.ListCount
     
    xlSh.Range("A1:I1").Value = Sheet2.Range("A1:L1").Value ' Başlıklar
    On Error Resume Next
    xlSh.Range("A1:I1").Interior.ColorIndex = 15 ' başlık arkaplan
    On Error Resume Next
    xlSh.Range("A1:I1").Font.ColorIndex = 56 'başlık yazı rengi
    On Error Resume Next
   

Dim satir As Long
Dim sutun As Long
For satir = 0 To ListBox1.ListCount - 1
For sutun = 0 To ListBox1.ColumnCount
    xlSh.Cells(satir + 2, sutun + 1) = ListBox1.List(satir, sutun) 'listboxtan verileri alma
    On Error Resume Next
   
Next sutun
Next satir
xlSh.UsedRange.RowHeight = 20 'satır yükseliği
On Error Resume Next
'Sayfa1.UsedRange.ColumnWidth = 30 'sütun genişliğini elle vermek isterseniz
xlSh.UsedRange.Columns.AutoFit 'otomatik sütun genişliği
On Error Resume Next
xlSh.UsedRange.HorizontalAlignment = xlCenter 'dikey yerleşim ortala
On Error Resume Next
xlSh.UsedRange.VerticalAlignment = xlVAlignCenter ' yatay yerleşim ortala
On Error Resume Next
xlSh.UsedRange.WrapText = False 'metni kaydırma
On Error Resume Next
xlSh.UsedRange.ShrinkToFit = True 'uyacak şekilde daralt
On Error Resume Next
xlSh.UsedRange.Borders.LineStyle = xlContinuous 'tablo çizgisi ekle
On Error Resume Next
xlSh.UsedRange.Borders.ColorIndex = 56 'tablo çizgisi rengi
On Error Resume Next
xlSh.UsedRange.Borders.Weight = xlThin 'tablo çizgi kalınlığı
On Error Resume Next
xlSh.PageSetup.Orientation = xlLandscape 'yatay yerleşim
On Error Resume Next
xlSh.PageSetup.LeftMargin = 1 'soldan pay
On Error Resume Next
xlSh.PageSetup.RightMargin = 1 'sağdan pay
On Error Resume Next
xlSh.PageSetup.TopMargin = 1 'üstten pay pay
On Error Resume Next
xlSh.PageSetup.FooterMargin = 1 'alttan pay pay
On Error Resume Next
   
    Next
Case vbNo
MsgBox "İşlem İptal Edildi.", vbMsgBoxSetForeground, "AKTAR"

End Select
End Sub
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 64
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot ve 0 misafir

Bumerang - Yazarkafe