Soru Kaynak Şablon kullanarak Otomatik köprü bağlantılı yeni sayfalar ekleme

G

gokhan_illik

Katılım
9 Ocak 2016
Mesajlar
12
Excel Vers. ve Dili
2010
merhaba arkadaşlar daha önce konusu olmuş ama artık ulaşılamıyor dosyaya..

benim bir excel dosyam var ve 1.sayfa KAYNAK 2.sayfa ANASAYFA (A1 - sapma numarası , B1 - Tarih , C1 - Açıklama ) hücreleri var .

Benim yapmak istediğim ANASAYFA üzerinde bir buton olacak yeni sapma oluştur adı altında butona tıklandığında bir form açılsın ve 3 adet seçenek çıksın. 1.Kalite Güvence Sapma Formu Oluştur 2. SatınAlma Sapma Formu Oluştur 3. Üretim Sapma Formu Oluştur şeklinde kullanıcı bu formda ilgili seçeneğini seçip OLUŞTUR dediğinde ANASAYFA A sütününa Kalite seçtiyse KG - Sapma - 0001 Satın almayı seçtiyse SA - Sapma - 0001 Üretim seçtiyse UR - sapma -0001 olarak hücreye yazıp aynı isimde KAYNAK ta bulunan hazır formu kullanarak yeni bir sayfa eklemesi ve bunuda köprülemesi. tekrar eden sapma oluşturmalarda 3 seçenek içinde hangisi seçildiyse sayı arttırarak devam etmeli.

Burada kullanıcı hiçbir şekilde sapma numarası ve sayfa ismine müdahale edememeli bunu kod ile otomatik yapması.
Tarih sutununa oluşturma tarihini yazdırabilirsek güzel olur.

Bu konuda yardımcı olan arkadaşlara şimdiden teşekkürlerimi sunarım. Kendim bir şeyler yapmak istesemde çorba ettim uzun zaman oldu makro ile uğraşmayalı nerdeyse çok şeyi unutmuşum.(en azından birşeylere başlayabiliyorduk..Şimdi o da yok.Tekrar çalışmaya başladım makroya sıfırdan.)

örnek dosyam...
https://www.dosyaupload.com/48Lnv/SAPMA__FORMU.xlsm
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Alternatif;
Deneyiniz

C#: 
Dim kod As String

Sub sapmaolustur()
  kod = "SAPMA"
  Call sayfa_olustur
End Sub

Sub satinalmaolustur()
  kod = "SA"
  Call sayfa_olustur
End Sub

Sub kaliteolustur()
  kod = "KA"
  Call sayfa_olustur
End Sub


Sub sayfa_olustur()
    Dim gun, ay, yil As Integer

    gun = Day(Date)
    ay = Month(Date)
    yilstr = Right(Trim(Str(Year(Date))), 2)
  
    If Len(gun) = 1 Then gunstr = "0" & gun
    If Len(ay) = 1 Then aystr = "0" & ay
  
    tarihstr = gunstr & aystr & yilstr
    sapmano = kod & "-" & tarihstr & "-0001"
  
tekrarara:
    For i = 1 To Sheets.Count
       If Trim(Sheets(i).Name) = Trim(sapmano) Then
           sapmasayi = Val(Right(sapmano, 4)) + 1
           If Len(sapmasayi) = 1 Then sapmasayistr = "000" & sapmasayi
           If Len(sapmasayi) = 2 Then sapmasayistr = "00" & sapmasayi
           If Len(sapmasayi) = 3 Then sapmasayistr = "0" & sapmasayi
           sapmano = Left(sapmano, Len(sapmano) - 4)
           sapmano = sapmano & sapmasayistr
           GoTo tekrarara
       End If
    Next i
  
    Sheets("KAYNAK").Select
    Sheets("KAYNAK").Copy after:=Sheets(2)
    ActiveSheet.Name = sapmano
    ActiveSheet.Range("M1").Value = sapmano
    ActiveSheet.Range("M2").Value = Date
    Sheets("ANASAYFA").Select
    Range("A2").Select
  
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    Range("A2:A" & sonsatir).Clear
    satir = 1
    For i = 1 To Sheets.Count
       If InStr(Sheets(i).Name, "-") > 0 Then
           satir = satir + 1
           ActiveSheet.Hyperlinks.Add Anchor:=Cells(satir, "A"), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
       End If
    Next i
  
End Sub
 
G

gokhan_illik

Katılım
9 Ocak 2016
Mesajlar
12
Excel Vers. ve Dili
2010
Asri' Alıntı:
Alternatif;
Deneyiniz

C#: 
Dim kod As String

Sub sapmaolustur()
  kod = "SAPMA"
  Call sayfa_olustur
End Sub

Sub satinalmaolustur()
  kod = "SA"
  Call sayfa_olustur
End Sub

Sub kaliteolustur()
  kod = "KA"
  Call sayfa_olustur
End Sub


Sub sayfa_olustur()
    Dim gun, ay, yil As Integer

    gun = Day(Date)
    ay = Month(Date)
    yilstr = Right(Trim(Str(Year(Date))), 2)

    If Len(gun) = 1 Then gunstr = "0" & gun
    If Len(ay) = 1 Then aystr = "0" & ay

    tarihstr = gunstr & aystr & yilstr
    sapmano = kod & "-" & tarihstr & "-0001"

tekrarara:
    For i = 1 To Sheets.Count
       If Trim(Sheets(i).Name) = Trim(sapmano) Then
           sapmasayi = Val(Right(sapmano, 4)) + 1
           If Len(sapmasayi) = 1 Then sapmasayistr = "000" & sapmasayi
           If Len(sapmasayi) = 2 Then sapmasayistr = "00" & sapmasayi
           If Len(sapmasayi) = 3 Then sapmasayistr = "0" & sapmasayi
           sapmano = Left(sapmano, Len(sapmano) - 4)
           sapmano = sapmano & sapmasayistr
           GoTo tekrarara
       End If
    Next i

    Sheets("KAYNAK").Select
    Sheets("KAYNAK").Copy after:=Sheets(2)
    ActiveSheet.Name = sapmano
    ActiveSheet.Range("M1").Value = sapmano
    ActiveSheet.Range("M2").Value = Date
    Sheets("ANASAYFA").Select
    Range("A2").Select

    sonsatir = Cells(Rows.Count, "A").End(3).Row
    Range("A2:A" & sonsatir).Clear
    satir = 1
    For i = 1 To Sheets.Count
       If InStr(Sheets(i).Name, "-") > 0 Then
           satir = satir + 1
           ActiveSheet.Hyperlinks.Add Anchor:=Cells(satir, "A"), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
       End If
    Next i

End Sub
Genişletmek için tıkla ...
yardımlarınız için sizlere teşekkür ederim buradan yola çıkarak düzenleme yapabilirim ..kendimce sıfırdan makro öğrenmeye başladım iyi bir kaynak kitap araştırıyorum umarım güzel bir şey bulurum...tekrar teşekkürler emeğinize Allah razı olsun...
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst