Otomatik sayfa oluşturma

[GOGO05]

Daha önce buna benzer bir örnek görmüştüm ama şimdi bulamadım. Sanırım makroyla yapılmıştı, yanlız benim makroyla ilgili hiç bir bilgim yok. Yardımcı olan arkadaşlara şimdiden teşekür ederim.

 

[Ömer]

Merhaba,

#12 nolu mesajda bir dosya hazırlamıştım, sanırım istediğiniz bunun gibi bir tablo..

http://www.excel.web.tr/f14/mu-teri-cari-hesap-ve-maliyet-t78363/sayfa2.html

.

 

[GOGO05]

ömer bey benim istediğim bu deyil. Mesela ana sayfaya harflerin olduğu yere ömer yazarsam ömer isminde bir sayfanın kendiliğinden oluşmasını istiyorum.

 

[Ömer]

Örnek dosya o işlemi yapmaktadır. Tekrar inceleminizi öneririm. Yalnız bu işlemi yaparken boş sayfa değil istediğiniz şablona göre olması örnek oluşturulan bir sayfaya göre sayfaları açar.

.

 

[GOGO05]

ömer bey o fonksiyonu bu örneğe uygulayabilirmisiniz rica etsem.?

 

[Ömer]

Eki inceleyiniz..

.

 

[GOGO05]

ömer bey elinize ve emeğinize sağlık.tşk

 

[berkmaz]

Ömer Bey
çok güzel ve çok yararlı bır tablo bende ışım gereğı exel tablolarıyla çok uğraşıyorum nasıl yaptığınızı banada anlatırmısınz
selamlar

 

[Ömer]

Merhaba,

Araçlar / Makro / Visual Basic Düzenleyicisi ekranından ThisWorbook sayfasında kodlar mevcuttur. Kendi dosyanıza uyarlayamazsanız küçük bir örnek ekleyerek açıklarsanız yardımcı olmaya çalışırım.

.

 

[sincarhakan]

teşekkürlerr

 

[simyaci64]

Eki inceleyiniz..

.

ÖMER BEY;

C1 C2 C3.... Hücresine tıkladığımda örnek1 i kopyalayıp oluştursa
D1 D2 D3.... hücresine tıkladığımda örnek2 i kopyalayıp oluştursa

bunu nasıl yapabiliriz. şimdiden tşekkürler.

 

[Ömer]

ÖMER BEY;

C1 C2 C3.... Hücresine tıkladığımda örnek1 i kopyalayıp oluştursa
D1 D2 D3.... hücresine tıkladığımda örnek2 i kopyalayıp oluştursa

bunu nasıl yapabiliriz. şimdiden tşekkürler.

Bu şekilde deneyin.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
    ByVal Target As Range, Cancel As Boolean)

    Dim sayfa As String, sor As String, sablon As String
    
    On Error GoTo son
    
    If ActiveSheet.Name <> "Anasayfa" Then
        Sheets("Anasayfa").Select
    Else
        sayfa = Target.Value
        If sayfa <> "" Then Sheets(sayfa).Select
    End If
    Exit Sub
son:
    If Intersect(Target, Sheets("Anasayfa").[C:D]) Is Nothing Then Exit Sub
    
    sor = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", _
        vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
    
    sablon = "örnek1"
    If Target.Column = 4 Then sablon = "örnek2"
    
    If sor = vbYes Then
        Sheets(sablon).Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Target.Value
        MsgBox Target.Value & " Sayfası Açıldı...", vbOKOnly, "www.excel.web.tr"
    Else
        Target.Offset(1, 0).Select
        Exit Sub
    End If

End Sub

.

 

[simyaci64]

ömer bey;

çalışmadı;

demek istediğim;

elimde 3 tane şablon sayfa var. sablon1 sablon2 sablon 3

ana sayfada a kolonundaki bir hücreye isim verip çift tıkladğımda sablon1 sayfasını kopyalamalı
ana sayfada b kolonundaki bir hücreye isim verip çift tıkladğımda sablon2 sayfasını kopyalamalı
ana sayfada c kolonundaki bir hücreye isim verip çift tıkladğımda sablon3 sayfasını kopyalamalı ve bunlara köprü oluşturma.

şimdidien teşekkür ederim.

saygılarımla.

 

[Ömer]

ÖMER BEY;

C1 C2 C3.... Hücresine tıkladığımda örnek1 i kopyalayıp oluştursa
D1 D2 D3.... hücresine tıkladığımda örnek2 i kopyalayıp oluştursa

bunu nasıl yapabiliriz. şimdiden tşekkürler.

Bu verdiğiniz örneğe görede çalışmadı mı?
Deneyerek yazmıştım, bende çalışmıştı. Kodları ThisWorkbook(Bu çalışma kitabı) sayfasının kod bölümüne kopyalamanız gerekir.

 

[simyaci64]

Bu verdiğiniz örneğe görede çalışmadı mı?
Deneyerek yazmıştım, bende çalışmıştı. Kodları ThisWorkbook(Bu çalışma kitabı) sayfasının kod bölümüne kopyalamanız gerekir.

ömer hocam; kopyaladım.
3 taner örnek dosyam var
örnek1 örnek2 örnek3
b kolununandaki hücreye yazdığım ismi örnek1 kopyalayıp yeni sayfa oluşturması ve otomatik köprü vermesi
c kolununandaki hücreye yazdığım ismi örnek2 kopyalayıp yeni sayfa oluşturması ve otomatik köprü vermesi
d kolununandaki hücreye yazdığım ismi örnek3 kopyalayıp yeni sayfa oluşturması ve otomatik köprü vermesi
istemiştim.
yardımlarınızdan dolayı çok teşekkür ederim.

saygılarımla.

 

[Ömer]

b kolununandaki hücreye yazdığım ismi örnek1 kopyalayıp yeni sayfa oluşturması ve otomatik köprü vermesi
c kolununandaki hücreye yazdığım ismi örnek2 kopyalayıp yeni sayfa oluşturması ve otomatik köprü vermesi
d kolununandaki hücreye yazdığım ismi örnek3 kopyalayıp yeni sayfa
.

İlgili bölümler için kodun içine açıklama yazdım.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
    ByVal Target As Range, Cancel As Boolean)

    Dim sayfa As String, sor As String, sablon As String
    
    On Error GoTo son
    
    If ActiveSheet.Name <> "Anasayfa" Then
        Sheets("Anasayfa").Select
    Else
        sayfa = Target.Value
        If sayfa <> "" Then Sheets(sayfa).Select
    End If
    Exit Sub
son:
    If Intersect(Target, Sheets("Anasayfa").[B:D]) Is Nothing Then Exit Sub 'B,C,D sütunları için
    
    sor = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", _
        vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
    
    If Target.Column = 2 Then sablon = "örnek1" '2. yani B sütunu
    If Target.Column = 3 Then sablon = "örnek2" '3. yani C sütunu
    If Target.Column = 4 Then sablon = "örnek3" '4. yani D sütunu
    
    If sor = vbYes Then
        Sheets(sablon).Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Target.Value
        MsgBox Target.Value & " Sayfası Açıldı...", vbOKOnly, "www.excel.web.tr"
    Else
        Target.Offset(1, 0).Select
        Exit Sub
    End If

End Sub

.

 

[simyaci64]

İlgili bölümler için kodun içine açıklama yazdım.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
    ByVal Target As Range, Cancel As Boolean)

    Dim sayfa As String, sor As String, sablon As String
    
    On Error GoTo son
    
    If ActiveSheet.Name <> "Anasayfa" Then
        Sheets("Anasayfa").Select
    Else
        sayfa = Target.Value
        If sayfa <> "" Then Sheets(sayfa).Select
    End If
    Exit Sub
son:
    If Intersect(Target, Sheets("Anasayfa").[B:D]) Is Nothing Then Exit Sub 'B,C,D sütunları için
    
    sor = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", _
        vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
    
    If Target.Column = 2 Then sablon = "örnek1" '2. yani B sütunu
    If Target.Column = 3 Then sablon = "örnek2" '3. yani C sütunu
    If Target.Column = 4 Then sablon = "örnek3" '4. yani D sütunu
    
    If sor = vbYes Then
        Sheets(sablon).Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Target.Value
        MsgBox Target.Value & " Sayfası Açıldı...", vbOKOnly, "www.excel.web.tr"
    Else
        Target.Offset(1, 0).Select
        Exit Sub
    End If

End Sub

.

ömer hocam burada hata veriyor.


Sheets(sablon).Copy After:=Sheets(Sheets.Count)

 

[Ömer]

örnek1
örnek2
örnek3

adında sayfalarınız var mı?

.

 

[simyaci64]

örnek1
örnek2
örnek3

adında sayfalarınız var mı?

.

hocam çok tşekkürler.

var sayfa adları ornek olduğundan olmamıştı şimdi onları örnek diye düzelttim.

çalışmamı yarın paylaşacağım...

dolar euro tl hesap sayfaları. ihtiyacı olan işine yarar.

saygılarımla.

iyi geceler.

 

[simyaci64]

hocam çok tşekkürler.

var sayfa adları ornek olduğundan olmamıştı şimdi onları örnek diye düzelttim.

çalışmamı yarın paylaşacağım...

dolar euro tl hesap sayfaları. ihtiyacı olan işine yarar.

saygılarımla.

iyi geceler.

merhaba;

ömer bey;

yardımlarınızla yapmış olduğum çalışma ektedir.

saygılarımla.