klasor ıcınde yenı SAYFA olusturma kodu yardım

[hypnose]

Gunaydın;

Ektekı lıste ıcınde beceremedıgım bır userform var
kodlamada yardımcı olursanız sevınırım

tum emeklerınız ıcın sımdıden tesekkur ederım

 

[uzmanamele]

merhaba
syn hypnose,
soru mesajınızda ne istediğiniz konusunda açıklama yapınız. bu bilgiler doğrultusunda konu hakkında yardım edecek arkadaşlar dosyanızı indirsin.

dosya içersinde de açıklama yok ki ne yapmak istiyorsunuz?

 

[hypnose]

dosya ıcınde dugme1 e tıklatınca cıkan userformda acıklmayaı yazdım

kısaca anlatmaya calısayım
userform uzerınde 4 adet textbox var
ve bu textboxlara gırdıgım degerler ıle ektekı klasorun ıcıne yenı bır kitap kopyalamasını ıstıyorum

 

[halit3]

user farmun içine bu kodu koy

Private Sub CommandButton1_Click()
'MsgBox ActiveWorkbook.Path ' Dosyanın yerini gösterir
MsgBox ThisWorkbook.Path
klasor = ThisWorkbook.Path & "\ORDER NUMARALARI"
On Error Resume Next
If Dir(klasor) = "" Then MkDir klasor
If TextBox1.Text = "" Then
MsgBox "Dosya ismini yazmadınız. ", vbInformation, c & " Hücresi"
Exit Sub
End If
Open klasor & "\" & TextBox1.Text & ".xls" For Append As #1
Print #1, TextBox1.Text & Chr(9) & TextBox3.Text & Chr(9) & TextBox2.Text & Chr(9) & TextBox4.Text
Close #1
End Sub

 

[hypnose]

sizi cok seviyorum ya
super oldu
birde al tarafta kitap sec vardı
combo box ıle yapılmıs
ordada kitap isimlerini gorsem ve sectigim kitap acılsa olabılırmı?

 

[halit3]

user forma bu kodları koyunuz.


Private Sub CommandButton1_Click()
'MsgBox ActiveWorkbook.Path ' Dosyanın yerini gösterir
MsgBox ThisWorkbook.Path
Klasor = ThisWorkbook.Path & "\ORDER NUMARALARI"
On Error Resume Next
If Dir(Klasor) = "" Then MkDir Klasor
If TextBox1.Text = "" Then
MsgBox "Dosya ismini yazmadınız. ", vbInformation, c & " Hücresi"
Exit Sub
End If
Open Klasor & "\" & TextBox1.Text & ".xls" For Append As #1
Print #1, TextBox1.Text & Chr(9) & TextBox3.Text & Chr(9) & TextBox2.Text & Chr(9) & TextBox4.Text
Close #1
End Sub

Private Sub UserForm_Initialize()
ComboBox1.Clear
On Error Resume Next
dosyalar = ThisWorkbook.Path & "\ORDER NUMARALARI"
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(dosyalar).Files
ComboBox1.AddItem Dosya.Name
Next
ComboBox1.Text = ComboBox1.ListCount & " Dosya var"
End Sub

 

[hypnose]

cok tesekkur ederım
combox sectıgım dosyayı acmıyor ama onuda ben bulacagım
bıraz arastırmak ıyı olur daha saglam ogrenılır

ellerınıze saglık

 

[halit3]

Ekli dosyanıza bakınız

 

[hypnose]

ekteki hatayı verdi
yardımcı olabılırsenız sevınrım
tesekkurler

 

[halit3]

ilk başta bu kod yokmu

Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long

benim gönderdiğim dosyada denedim çalışıyor

 

[hypnose]

ellerıne saglık
benım dıkkatsızlıgımden kaynaklanmıs

hersey ıcın cok tesekkurler