TextBox1 e girilen bir isimle yeni çalışma sayfası açma

oerbas · 5 Kasım 2004

TextBox1 e girilen Ãiret Kısa Adının Sayfa Sekme
isimlerine atanmasını sağlamak böylece her müşteriye ait bir cari kart oluşturmak istiyorum.
Onay Butonuna tıklayınca her sayfanın bu formatta
olması mümkünmü

Yardımcı olacak arkadaşa şükranlarımı iletirim.

Gönderdiğim örnek dosya incelenerek yardımcı olunursa diğer arkadaşlar içinde faydalı olur kanaatindeyim

xxrt · 5 Kasım 2004

Belli Bir Hücrede Bulunan Değere Göre Sayfa İsmi Açmak.
Dosyayı inceleyin takıldığınız yerde sorarsınız.

Haluk · 5 Kasım 2004

İlavelerinizi yaparsınız.

Kod:

Private Sub CommandButton2_Click()
    If Not TextBox1 = Empty Then
        For i = 1 To Worksheets.Count
            If Sheets(i).Name = TextBox1 Then
                MyQ = MsgBox("Bu isimde bir şirket var, değişik bir isim girmelisiniz !")
                TextBox1 = Empty
                TextBox1.SetFocus
                Exit Sub
            End If
        Next
        Set NewSh = Worksheets.Add
        With NewSh
            .Name = TextBox1
            .Range("A1") = Label2
            .Range("A2") = Label3
            .Range("A3") = Label4
            .Range("A4") = Label5
            .Range("B1") = TextBox2
            .Range("B2") = TextBox3
            .Range("B3") = TextBox4
            .Range("B4") = TextBox5
            .Range("B5") = TextBox6
            .Columns("A:A").ColumnWidth = 12
            .Columns("B:B").ColumnWidth = 34
            .Columns("C:C").ColumnWidth = 19
            .Columns("D:D").ColumnWidth = 19
        End With
    End If
    Set NewSh = Nothing
End Sub

Fenomen · 6 Kasım 2004

eline sağlık
peki bunu sheet1 imizi istediğimiz adla farklı kaydetmek için kullanmak istesek ne yapmamız gerekir acaba?

Hüseyin · 6 Kasım 2004

aşağıdaki linkte farklı kaydet örneği bulunmaktadır. Bunu koda ilave edebilirsiniz.

http://www.excel.web.tr/viewtopic.php?t=408

Fenomen · 6 Kasım 2004

Saolasın çok işime yaradı

oerbas · 8 Kasım 2004

Evdeki bilgisayarı şu an için kullanamamam ve Hafta sonu tatili olması münasebeti ile size teşekkür mesajı yazmadım. Verdiğiniz bu güzel bilgiler için teşekkürlerimi iletirim.

Ãunları söylemeden edemeyeceğim Forma üye olduğumdan beri kendimi bir hayli geliştirdim. Bilgi cimrisi bir toplumda sizler gibi insanlarla bu formda buluşmak ne kadar hoş.
Hiç kuşkum yokki sizlerde birilerine birşeyler öğretmekten zevk alıyorsunuz.

Sayın xxrt ve cevap yazan arkadaşlara teşekkür ederim. Hoşça kalınız

Fenomen · 8 Kasım 2004

Private Sub iBKytBtn_Click()
On Error GoTo klasorac
121:
arsiv = ySyfAd & " " & Range("AQ1") & " " & "Tarihli Maliyet Çalışması" & ".xls"
ChDrive "C"
ChDir "C:\Maliyetler"
dosya = WorksheetFunction.Substitute(arsiv, "/", "-") ' / ları nokta yapsın.
ActiveWorkbook.SaveAs Filename:=arsiv
GoTo 313
Unload Me

klasorac:
MsgBox ("Maliyetler Klasörünüz Bulunamadı Oluşturmak İçin Tamama Tıklayın")
MkDir "C:\Maliyetler"
GoTo 121
313:
End Sub

ben kodu bu şekilde düzenledim çalışıyor ama kaydettiğim dosya ile aynı adda başka bir dosya varsa windows soruyor böyle bir dosya var değiştireyimmi diyor evet dersen sorunyok değiştiriyor ama hayır dersen klasorac a gidip hata veriyor bu engellemek için bir şey yapa bilirmiyiz yani o klasörde aynı adda bir dosya varsa kodla denetlemesini sağlaya bilirmiyiz?
iyi çalışmalar.

Haluk · 8 Kasım 2004

....yani o klasörde aynı adda bir dosya varsa kodla denetlemesini sağlaya bilirmiyiz?....

Ã?rnek olarak bilgisayarda C:\Temp klasörü varsa ve siz de bu klasörde Test.xls dosyasının var olup olmadığını kontrol etmek istiyorsanız; şöyle bir şey olabilir:

Kod:

Sub TestFile()
    MyFile = "C:\Temp\Test.xls"
        If Dir(MyFile) <> "" Then
            MsgBox MyFile & " dosyası mevcut."
        Else
            MsgBox MyFile & " dosyası mevcut değil."
        End If
End Sub

oerbas · 8 Kasım 2004

Sayın Raider

Yazdığınız koda ben kendim eklentiler yaptım çalıştırdığımda Ãu hatıyı alıyorum yarıdımcı olabilirmisiniz

Run time error 1004
Border Sınıfının Linestyle özelliği kurulamıyor

Hocam özür dilerim sadece binim eklediğim bölüm hata veriyor. Eklenen bölüm ise A1

8 Hücre aralığına çerçeve çizgisi ekliyor
A9

9 Hücre aralığının klavuz çizgilerini aktif hale getiriyor. Bu makroyu sizin yazdığınız makroya eklemek istiyorum

Haluk · 8 Kasım 2004

Ãöyle bir şey olur mu ?

Kod:

Private Sub CommandButton2_Click()
    If Not TextBox1 = Empty Then
        For i = 1 To Worksheets.Count
            If Sheets(i).Name = TextBox1 Then
                MyQ = MsgBox("Bu isimde bir şirket var, değişik bir isim girmelisiniz !")
                TextBox1 = Empty
                TextBox1.SetFocus
                Exit Sub
            End If
        Next
        Set NewSh = Worksheets.Add
        With NewSh
            .Name = TextBox1
            .Range("A1") = Label2
            .Range("A2") = Label3
            .Range("A3") = Label4
            .Range("A4") = Label5
            .Range("B1") = TextBox2
            .Range("B2") = TextBox3
            .Range("B3") = TextBox4
            .Range("B4") = TextBox5
            .Range("B5") = TextBox6
            .Columns("A:A").ColumnWidth = 12
            .Columns("B:B").ColumnWidth = 34
            .Columns("C:C").ColumnWidth = 19
            .Columns("D:D").ColumnWidth = 19
        End With
    End If
    
    With Range("A9:D9")
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    End With
    
    With Range("A1:D8")
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    
    Set NewSh = Nothing
End Sub

oerbas · 9 Kasım 2004

Hocam Sizin gönderdiğiniz son kod çok güzel Ben bu koda ilaveler yapmaya çalıştım. Dolaysıyla aşağıdaki gibi uzunca bir kod yazıldı. Bu kodu biraz daha kısaltabilirmiyiz.

D1 hÜcresinde C9 sütununu D2 Hücresindede D Sütununa girilen sayıların toplamlarının alınması (C9 VE D9 ) dan başlamak üzere Yani aşağıdaki kodun daha pratik bir yolu olabilirmi. Sayggılarımla

Private Sub CommandButton2_Click()
If Not TextBox1 = Empty Then
For i = 1 To Worksheets.Count
If Sheets(i).Name = TextBox1 Then
MyQ = MsgBox("Bu isimde bir şirket var, değişik bir isim girmelisiniz !")
TextBox1 = Empty
TextBox1.SetFocus
Exit Sub
End If
Next
Set NewSh = Worksheets.Add
With NewSh
.Name = TextBox1
.Range("A1") = Label2
.Range("A2") = Label3
.Range("A3") = Label4
.Range("A4") = Label5
.Range("B1") = TextBox2
.Range("B2") = TextBox3
.Range("B3") = TextBox4
.Range("B4") = TextBox5
.Range("B5") = TextBox6
Columns("C

").Select
Selection.NumberFormat = "#,##0 _T_L"
' Makro oerbas tarafından 08.11.2004 tarihinde kaydedildi.
Range("A1

7").Select
Range("A8

8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
.Columns("A:A").ColumnWidth = 12
.Columns("B:B").ColumnWidth = 34
.Columns("C:C").ColumnWidth = 19
.Columns("D

").ColumnWidth = 19

'Benim yaptığım ekleme
'Satır ve Sütun Genişlikleri ayarlanıyor

Rows("8:8").RowHeight = 26.25
Range("A8").Select
'Hocam Bu satır bilgileri girilmesi gerekiyor
ActiveCell.FormulaR1C1 = "TARİH"
Range("B8").Select
ActiveCell.FormulaR1C1 = "AÇIKLAMA"
Range("C8").Select
ActiveCell.FormulaR1C1 = "BORÇLU "
Range("D8").Select
ActiveCell.FormulaR1C1 = "ALACAKLI"
Range("B11").Select
ActiveWindow.SmallScroll Down:=-9
Range("C1").Select
ActiveCell.FormulaR1C1 = "Toplam Borç Bakiyesi"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Toplam Alacak Bakiyesi"
Range("C3").Select
ActiveCell.FormulaR1C1 = "Bugünkü Bakiye"
Range("C13").Select
ActiveWindow.SmallScroll Down:=18
Range("C34").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-25]C:R[7]C)"
Range("C35").Select
Application.CommandBars("Circular Reference").Visible = False
ActiveWindow.SmallScroll Down:=-36
Range("C34").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "=SUM(R[-25]C:R[-3]C)"
Range("D34").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-25]C:R[-2]C)"
Range("D35").Select
ActiveWindow.SmallScroll Down:=-33
Range("D1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[8]C[-1]:R[31]C[-1])"
Range("D2").Select
ActiveWindow.SmallScroll Down:=-9
Range("D2").Select
ActiveCell.FormulaR1C1 = "=SUM(R[7]C:R[30]C)"
Range("D3").Select
ActiveWindow.SmallScroll Down:=-18
ActiveWorkbook.Save
'Normal
End With
End If
Set NewSh = Nothing
End Sub

Private Sub CommandButton3_Click()
If Not TextBox1 = Empty Then
For i = 1 To Worksheets.Count
If Sheets(i).Name = TextBox1 Then
MyQ = MsgBox("Bu isimde bir şirket var, değişik bir isim girmelisiniz !")
TextBox1 = Empty
TextBox1.SetFocus
Exit Sub
End If
Next
Set NewSh = Worksheets.Add
With NewSh
.Name = TextBox1
.Range("A1") = Label2
.Range("A2") = Label3
.Range("A3") = Label4
.Range("A4") = Label5
.Range("B1") = TextBox2
.Range("B2") = TextBox3
.Range("B3") = TextBox4
.Range("B4") = TextBox5
.Range("B5") = TextBox6
.Columns("A:A").ColumnWidth = 12
.Columns("B:B").ColumnWidth = 34
.Columns("C:C").ColumnWidth = 19
.Columns("D

").ColumnWidth = 19
End With
End If

With Range("A8

8")
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With

With Range("A1

7")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

Set NewSh = Nothing
End Sub

TextBox1 e girilen bir isimle yeni çalışma sayfası açma

oerbas

xxrt

Misafir

Haluk

𐱅𐰇𐰼𐰚

Fenomen

Hüseyin

Administrator

Fenomen

oerbas

Fenomen

Haluk

𐱅𐰇𐰼𐰚

oerbas

Haluk

𐱅𐰇𐰼𐰚

oerbas