Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
29/04/2019 17:51
Konu Sahibi
ertus35
Yorumlar
3
Okunma
256
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy

ertus35

Üye
103369
 36
 4
 19
 26/03/2019
0
 İzmir
 MİMAR
 Ofis 2007
 Bugün,03:27
Çözüldü 
Merhaba üstadlar,

Ben ekte bir örnek İş Emri Açma excel'i oluşturdum.

A4,A5,A6.... hücrelerine çift tıkladığımda yeni bir sheet açabiliyorum, fakat tüm sheetler(Genel Şablon Sheet'im İş Emri) aynı içerikte oluyor.

Yapmak istediğimi A4 hücresine çift tıkladığımda 4 satırındaki bilgileri alıp yeni bir sheet oluştursun, A5 hücresine çift tıkladığımda 5 satırındaki bilgileri alıp yeni bir sheet oluştursun. Genel Şablonum İş Emri Sheet'idir.
Yardımlarınız için teşekkür ederim.



haliliyas

Uzman
65596
Ha.... Ya....
 Belirtilmemiş
 23
 1.031
 30/07/2014
172
 -
 
 Ofis 2019 64 Bit
 Bugün,22:21
yalnız sizin yaptığınız sadece işemrinin kopyasını oluşturmak ve is emri de sabit hücrelere bağlı
kodu aşağıdaki gibi dener misini 2 satır ekledim onları eklemeniz yeter

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
Dim Sayfa As String
Dim ts
AktifHucre = ActiveCell.Row  '<=== bu satır tıklanan hücrenin satır bilgisini alıyor
If ActiveSheet.Name <> "W.O KAYIT" Then

Else
    Sayfa = Target.Value
    If Sayfa <> "" Then Sheets(Sayfa).Select
End If
Exit Sub
Son:
If Intersect(Target, Sheets("W.O KAYIT").Range("A4:A23000")) Is Nothing Then Exit Sub
Sordum = MsgBox(Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açılıyor", vbYesNo, "                               Değerli Çalışan   ")
If Sordum = vbYes Then
    Sheets("İŞ EMRİ").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    Worksheets(Target.Value).Range("A1:Z100").Replace "4", AktifHucre '<== bu satır yeni sayfanın kodlarını ='W.O KAYIT'!C4 sadece 4  değerini aktif hücrenin satır nosu ile değiştiriyor
    MsgBox Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açıldı", vbOKOnly, "                               Değerli Çalışan    "
ts = "B2"
Range(ts) = ActiveSheet.Name
End If
End Sub



ertus35

Üye
103369
 36
 4
 19
 26/03/2019
0
 İzmir
 MİMAR
 Ofis 2007
 Bugün,03:27
(29/04/2019 20:18)haliliyas Adlı Kullanıcıdan Alıntı: yalnız sizin yaptığınız sadece işemrinin kopyasını oluşturmak ve is emri de sabit hücrelere bağlı
kodu aşağıdaki gibi dener misini 2 satır ekledim onları eklemeniz yeter

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
Dim Sayfa As String
Dim ts
AktifHucre = ActiveCell.Row  '<=== bu satır tıklanan hücrenin satır bilgisini alıyor
If ActiveSheet.Name <> "W.O KAYIT" Then

Else
    Sayfa = Target.Value
    If Sayfa <> "" Then Sheets(Sayfa).Select
End If
Exit Sub
Son:
If Intersect(Target, Sheets("W.O KAYIT").Range("A4:A23000")) Is Nothing Then Exit Sub
Sordum = MsgBox(Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açılıyor", vbYesNo, "                               Değerli Çalışan   ")
If Sordum = vbYes Then
    Sheets("İŞ EMRİ").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    Worksheets(Target.Value).Range("A1:Z100").Replace "4", AktifHucre '<== bu satır yeni sayfanın kodlarını ='W.O KAYIT'!C4 sadece 4  değerini aktif hücrenin satır nosu ile değiştiriyor
    MsgBox Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açıldı", vbOKOnly, "                               Değerli Çalışan    "
ts = "B2"
Range(ts) = ActiveSheet.Name
End If
End Sub


Hocam yazdığınız kod problemsiz çalıştı. Çok teşekkür ederim değerli vaktinizi harcadığınız için.
Emeğinize sağlık.

saygılar



haliliyas

Uzman
65596
Ha.... Ya....
 Belirtilmemiş
 23
 1.031
 30/07/2014
172
 -
 
 Ofis 2019 64 Bit
 Bugün,22:21
Önemli değil iyi çalışmalar )




Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü excel programını accese çevirme ultramir 5 2.648 07/04/2019, 19:28
Son Yorum: Emre kırkkılıc
Çözüldü 2 excel dosyası arasında kritere göre bağ yapıştırma mehmetdemiral 19 5.825 17/04/2018, 12:47
Son Yorum: Subco
Çözüldü Excel hücrede sayısal değeri yazı ile gösterme sezginsasm 20 9.107 29/03/2018, 12:27
Son Yorum: MKMK2018
Çözüldü Excel De Düşeyara Formülü #yok Hatası Veriyor... mehmet yaşar öztürk 9 2.015 08/01/2018, 11:06
Son Yorum: canazor
Çözüldü Excel Yıllık İzin Tablosu mehmetfetih 2 5.445 06/08/2017, 09:47
Son Yorum: mehmetfetih

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.