• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfa 2'deki taksit tablosunun Sayfa1'deki B21 hücresindeki sayı kadar aktif olması

M

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
633
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
İyi Günler;

Ekli Excel çalışma kitabımın 1. sayfası "Ödeme planı", 2. sayfası Taksittablosu adı ile kayıtlıdır

Ödeme Planı sayfasının B20 hücresi bakiye Bedel
Ödeme Planı sayfasının B21 hücresi taksit sayısı bulunmaktadır.

Yine Taksittablosu sayfasının B20 hücresi bakiye Bedel
Taksittablosu sayfasının B21 hücresi taksit sayısı bulunmakta ve ödeme planı sayfasında bağlantılı olarak bakiye bedel ve taksit sayısı değiştiğinde değişmektedir.

Aşağıdaki makro ile taksittablosu B21 hücresine tıklamadan taksit sayısı kadar aktif olmamaktadır.
Ancak, Ödeme planında B21 hücresindeki taksit sayısının giriş yapıldığında, Taksittablosu sayfasının B21 hücresine tıklamadan tablonun taksit sayısı kadar aktifleşmesini istiyorum.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B21"), Target) Is Nothing Then
If Target.Value < 21 Then
Rows("27:50").Hidden = False
Rows(50 - (23 - Target.Value) & ":50").Hidden = True
End If
End If
End Sub
 

Ekli dosyalar

İyi Günler;

Çalışma kitabını kaydetmeden kapatmışım.

Ödeme Planı sayfasının B26 hücresi bakiye Bedel
Ödeme Planı sayfasının B27 hücresi taksit sayısı bulunmaktadır.

Yine Taksittablosu sayfasının B20 hücresi bakiye Bedel
Taksittablosu sayfasının B21 hücresi taksit sayısı bulunmakta ve ödeme planı sayfasında bağlantılı olarak bakiye bedel ve taksit sayısı değiştiğinde değişmektedir.

Aşağıdaki makro ile taksittablosu B21 hücresine tıklamadan taksit sayısı kadar aktif olmamaktadır.
Ancak, Ödeme planında B27 hücresindeki taksit sayısının giriş yapıldığında, Taksittablosu sayfasının B21 hücresine tıklamadan tablonun taksit sayısı kadar aktifleşmesini istiyorum.
 

Ekli dosyalar

Sayın Muhasebeciyiz;

Yardım ve ilginiz için teşekkürler.
Kodlar sorunsuz olarak çalışmaktadır.
Ancak, modulün içindeki

Public Sub TaksitTablosunuGuncelle()
Dim ws As Worksheet
Dim TaksitSayisi As Long
Set ws = ThisWorkbook.Worksheets("Taklsittablosu")
ws.Calculate
DoEvents
TaksitSayisi = Val(ws.Range("B21").Value2)
End Sub

makro Taklsittablosu B21 hücresini günleme yapmıyor. Nerede yanlışlık yapıyor olabilirim.
Ödeme planı sayfasının B27 hücresini kopyalayıp bağlantılı olarak yapıştırmaktayım.
 
İyi Akşamlar;
Konu hakkında ilgi ve yardımlarınız için teşekkürler. İşyerinde kısıtlama olduğundan konu hakkında görüş ve önermeleri bildiremedim.

Kodda ve işlemde hata olduğunu iddia etmedim. Sadece Ödeme Planındaki B27 hücresindeki değeri Taksittablosu sayfasının B21 hücresinde otomatik günceleme yapması konusunda , kopyala, bağlantalı yapıştır ile değil
Modülün içindeki
Public Sub TaksitTablosunuGuncelle()
Dim ws As Worksheet
Dim TaksitSayisi As Long
Set ws = ThisWorkbook.Worksheets("Taksittablosu")
ws.Calculate
DoEvents
TaksitSayisi = Val(ws.Range("B21").Value2)
End Sub

kodun işlevini çözemediğim, konuyu anlayabilmek istemiştim.
 
mars2' Alıntı:
İyi Akşamlar;
Konu hakkında ilgi ve yardımlarınız için teşekkürler. İşyerinde kısıtlama olduğundan konu hakkında görüş ve önermeleri bildiremedim.

Kodda ve işlemde hata olduğunu iddia etmedim. Sadece Ödeme Planındaki B27 hücresindeki değeri Taksittablosu sayfasının B21 hücresinde otomatik günceleme yapması konusunda , kopyala, bağlantalı yapıştır ile değil
Modülün içindeki
Public Sub TaksitTablosunuGuncelle()
Dim ws As Worksheet
Dim TaksitSayisi As Long
Set ws = ThisWorkbook.Worksheets("Taksittablosu")
ws.Calculate
DoEvents
TaksitSayisi = Val(ws.Range("B21").Value2)
End Sub

kodun işlevini çözemediğim, konuyu anlayabilmek istemiştim.
Genişletmek için tıkla ...
bende onu tahmin ederek kodları açıklamalı yazmaya çalışmıştım
 
Merhaba,
1- Otomatik hesaplamayı kapalı mı tutuyorsunuz?
2- Taklsittablosu B21 de bulunan ='Ödeme planı'!$B$27 formülü kullanmayacak mısınız?
3- Ödeme planı Sayfası B27 den seçim yaptığınızda otomatik olarak Makro ile Taklsittablosu B21 hücresindeki değere yansımasını mı istiyorsunuz?
4- Değişkene atama işlemini farklı yerlerde kullanmak için mi yazdınız?

Sanırım bunlar netleşirse doğru koda erişebileceksiniz.
 
İyi Akşamlar;
1- Otomatik hesaplamayı kapalı mı tutuyorsunuz? - Hayır
2- Taksittablosu B21 de bulunan ='Ödeme planı'!$B$27 formülü kullanmayacak mısınız? - Kullanılacak ancak, Ödeme planı'!$B$27 hücresindeki değeri Taksittablosu B21 hücresine aktarmak , = Ödeme planı'!$B$27 formülü yerine makro ile olabilir.
3- Ödeme planı Sayfası B27 den seçim yaptığınızda otomatik olarak Makro ile Taksittablosu B21 hücresindeki değere yansımasını mı istiyorsunuz? - Evet
4- Değişkene atama işlemini farklı yerlerde kullanmak için mi yazdınız? - Hayır, Ödeme planı sayfası B27 hücresindeki değer kadar ödeme tablosunda işlem yapmak
 
Merhaba,

Sayfa1(Ödeme planı) içinde bulunan kodu bu şekilde güncelleyiniz. Artık taksiti seçtiğinizde söz konusu hücrede formül olmadığı halde taksit sayısı yazacak ve tablo eskisi gibi işlevini yerine getirecektir.
*Yapay zeka tarafından kod iyileştirildi.

C++: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim TaksitSayisi As Long
    Dim wsTaksit As Worksheet

    On Error GoTo Cikis

    ' B27'de bir değişiklik olup olmadığını kontrol et
    If Intersect(Target, Me.Range("B27").MergeArea) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    Set wsTaksit = ThisWorkbook.Worksheets("Taklsittablosu")

    ' B27'deki değeri al
    TaksitSayisi = Val(Me.Range("B27").Value)
    
    ' --- YENİ EKLENEN KISIM ---
    ' Ödeme planı B27'deki değeri Taksittablosu B21'e yaz
    wsTaksit.Range("B21").Value = TaksitSayisi
    ' --------------------------

    ' Mevcut satır gizleme mantığınız
    wsTaksit.Rows("27:50").Hidden = False

    If TaksitSayisi > 0 And TaksitSayisi < 21 Then
        wsTaksit.Rows(50 - (23 - TaksitSayisi) & ":50").Hidden = True
    End If

Cikis:
    Application.EnableEvents = True

End Sub
 
İyi Günler;

Konu hakkında yardım ve ilgilerini esirgemeyen herkese teşekkürler.
sayın netzone tarafından eklenen aşağıdaki kod satırı anlatmak istediğim konudu idi
wsTaksit.Range("B21").Value = TaksitSayisi

Bu konuya bağlı olarak bu iki ayrı sayfaları önlü arkalı yazdırmak istiyorum. Yazıcımda iki yüze yazdırı etkinleştirmem rağmen aşağıdaki kodla yazdırmaya çalıştığımda, ayrı sayfa olarak yazdırmaktadır.

Sub Düğme3_Tıkla()
'Dim Yazıcı As String

If MsgBox("YAZDIRMA İŞLEM YAPILACAK MI?", vbYesNo + 32, "DİKKAT !") = vbNo Then
MsgBox "Yazdırma işlemi iptal edildi."
Else
yaziciv = Application.ActivePrinter
ActiveWorkbook.Sheets(Array("Ödemeplanı", "Taksittablosu")).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Application.ActivePrinter = yaziciv
MsgBox "yazdırma işlemi tamamlandı.", vbInformation
End If
Sheets("Ödemeplanı").Select
End Sub
 
Kod: 
Option Explicit

Sub Düğme3_Tıkla()

    Dim anaKitap As Workbook
    Dim yazdirmaKitabi As Workbook
    Dim wsOdeme As Worksheet
    Dim wsTaksit As Worksheet
    Dim ws As Worksheet
    Dim hataNo As Long
    Dim hataMesaji As String
    
    Set anaKitap = ActiveWorkbook
    
    On Error Resume Next
    Set wsOdeme = anaKitap.Worksheets("Ödeme planı")
    Set wsTaksit = anaKitap.Worksheets("Taklsittablosu")
    On Error GoTo 0

    If wsOdeme Is Nothing Then
        MsgBox anaKitap.Name & " dosyasında 'Ödemeplanı' sayfası bulunamadı.", _
               vbExclamation, "Sayfa bulunamadı"
        Exit Sub
    End If

    If wsTaksit Is Nothing Then
        MsgBox anaKitap.Name & " dosyasında 'Taksittablosu' sayfası bulunamadı.", _
               vbExclamation, "Sayfa bulunamadı"
        Exit Sub
    End If

    If MsgBox("YAZDIRMA İŞLEMİ YAPILACAK MI?", _
              vbYesNo + vbQuestion, "DİKKAT!") = vbNo Then

        MsgBox "Yazdırma işlemi iptal edildi.", vbInformation
        Exit Sub
    End If

    On Error GoTo Hata

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    anaKitap.Worksheets(Array(wsOdeme.Name, wsTaksit.Name)).Copy

    Set yazdirmaKitabi = ActiveWorkbook
    
    For Each ws In yazdirmaKitabi.Worksheets
        With ws.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
    Next ws
    
    yazdirmaKitabi.PrintOut Copies:=1, Collate:=True

    yazdirmaKitabi.Close SaveChanges:=False

    anaKitap.Activate
    wsOdeme.Activate

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "Yazdırma işlemi tamamlandı.", vbInformation
    Exit Sub

Hata:

    hataNo = Err.Number
    hataMesaji = Err.Description

    On Error Resume Next

    If Not yazdirmaKitabi Is Nothing Then
        yazdirmaKitabi.Close SaveChanges:=False
    End If

    anaKitap.Activate

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    On Error GoTo 0

    MsgBox "Hata numarası: " & hataNo & vbCrLf & _
           "Hata açıklaması: " & hataMesaji, _
           vbCritical, "Yazdırma hatası"

End Sub

Deneyip dönüş yapınız
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst