Sıra numarası ile Kaydet butonu

[muttabomer]

Selamun Alkeyküm hocalarım,

Benim sıkıntı şu konuda, Bir Fatura kesme şablonu oluşturdum,

Bu şablada bilgileri girdiğim zaman, Kaydetmek için bir buton ayarladım, bu butona tıkladığım zaman H24 hücresindeki FirmaAdı ve CH50 deki tarihi otomatik olarak algılasın ve Ön kısmıda Faturanın Numarası bana sorup kaydetsin. Örneğin: "084041_FirmaAdı_13.11.2017"

Şimdiden yardımlarınız için teşekkür ederim.

 

[Ömer]

Merhaba,

Bu şekilde deneyin. Masa üstüne kaydeder.

Sub Kaydet()

    Dim yol As String, ft_no As String

    yol = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop")
    ft_no = Application.InputBox("Fatura Numarasını Yazın.", "KAYIT")
    
    If ft_no = "" Then
        MsgBox "Kayıt Yapmadım! ....... Fatura No Boş Bırakılmaz"
        Exit Sub
    End If

    ActiveWorkbook.SaveCopyAs Filename:=yol & "\" & ft_no & "_" & _
        [H25] & "_" & Format([CH50], "_dd.mm.yyyy") & ".xlsx"
        
End Sub

.

 

[muttabomer]

Çalışma Hatası 429 verdi

Birde Dosya Yolu Şu şekilde yapabilirmiyiz
"/Volumes/Merkez_MAC/MERKEZ/H/01_HALİL KÜÇÜKKINACI/FATURALAR/MAC_FATURALAR" içerisine kayıt etsin

 

[Ömer]

yol tanımlamasındaki CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") yazan bölümünü silerek kayıt adresini tam olarak yazarak deneyin.

yol = "C:\Volumes\Merkez_MAC\MERKEZ\H\01_HALİL KÜÇÜKKINACI\FATURALAR\MAC_FATURALAR"

Gibi. Adresi siz kontrol edersiniz.

.

 

[muttabomer]

Çok teşekkür ederim oldu hocam,
Ufak bir yeri unutmuşum,
Kayıt ettiğinde sadece bilgileri yazdığım, Sheets("FATURA") kayıt etsin diğer 2 ve 3 üncü sayfaları kaydetmesin.

 

[anemis]

Çok gizli değilse çalışmanızı paylaşmanızı rica edeceğim sayın muttabomer Benim gibi bu tür işlere yeni başlamış olanlar için çok faydalı bir örnek olacağına eminim.

 

[muttabomer]

Anemis son bir düzeltme kaldı onuda tamamlayınca neden olmasın,
son düzeltme için cevap bekliyorum, oda tamamlasın başüstüne.

 

[anemis]

Anemis son bir düzeltme kaldı onuda tamamlayınca neden olmasın,
son düzeltme için cevap bekliyorum, oda tamamlasın başüstüne.

Estafurullah, konuyu takibe alıyorum. Paylaşımcılığınız için şimdiden teşekkür ederim.

 

[Ömer]

Çok teşekkür ederim oldu hocam,
Ufak bir yeri unutmuşum,
Kayıt ettiğinde sadece bilgileri yazdığım, Sheets("FATURA") kayıt etsin diğer 2 ve 3 üncü sayfaları kaydetmesin.

Bu şekilde deneyin.

Sub Kaydet()

    Dim yol As String, ft_no As String

    yol = "C:\Volumes\Merkez_MAC\MERKEZ\H\01_HALI·L KU¨C¸U¨KKINACI\FATURALAR\MAC_FATURALAR"
    ft_no = Application.InputBox("Fatura Numarasını Yazın.", "KAYIT")
    
    If ft_no = "" Then
        MsgBox "Kayıt Yapmadım! ....... Fatura No Boş Bırakılmaz"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveWorkbook.Sheets("FATURA").Copy
    ActiveWorkbook.SaveAs Filename:=yol & "\" & ft_no & "_" & _
        [H25] & "_" & Format([CH50], "_dd.mm.yyyy") & ".xlsx"
    ActiveWorkbook.Close
    
    Application.ScreenUpdating = True
        
End Sub

.

 

[muttabomer]

Teşekkür ederim hocam,

Çalışma Zaman hatası '1004':

Worksheet sınıfının Copy yöntemi başarısız dedi.

ActiveWorkbook.Sheets ("FATURA").Copy de kalde

 

[Ömer]

Boş bir excel dosyasında kodları dener misiniz. Yinede hata alıyor musunuz ?

Dosyanızı eklemeniz mümkün mü?

www.dosya.tc

.

 

[muttabomer]

http://s8.dosya.tc/server5/2qy3zb/ENVER.zip.html

Ömer hocam yukarıdaki linkten indirebilirsiniz. Yardımlarınız için çok teşekkür ederim.
Bu konuyuda çözersem birde aklımda şey var Sayın kısmını Dolaylı olarak formülledim, onu makro ile ayarlayabilirmiyiz.
Birde göreceğiniz üzere Firma bilgilerini düşeyara ile ayarladım ama onlarıda makro ile yapsak. tıklandığında formül yerine
bilgiler yazsa çok iyi olur du.

 

[Ömer]

Dosya uzantısını xlsm olarak değiştirdiğiniz için hata almışsınız.

Bu şekilde deneyin.

Sub FarkliKaydet()

    Dim yol As String, ft_no As String

    yol = "/Volumes/Merkez_MAC/MERKEZ/H/01_HALÜL K†‚†KKINACI/FATURALAR/MAC_FATURA/"
    ft_no = Application.InputBox("Fatura Numarasİnİ Yazİn.", "KAYIT")
    
    If ft_no = "" Then
        MsgBox "Kayİt Yapmadİm! ....... Fatura No Boß Bİrakİlmaz"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ActiveWorkbook.Sheets("FATURA").Copy
    ActiveWorkbook.SaveAs Filename:=yol & "" & ft_no & "_" & _
        [H24] & "_" & Format([CH50], "_dd.mm.yyyy") & ".xlsm", FileFormat:=52
    ActiveWorkbook.Close
    
    Application.ScreenUpdating = True
End Sub

2. sorunuz için:

Fatura sayfası kod bölümüne kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim c As Range
    
    If Intersect(Target, [H24]) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    With Sheets("TÜM FİRMALAR")
        Set c = .[A:A].Find(Target, , xlFormulas, xlWhole)
        If Not c Is Nothing Then
            Range("H28") = .Cells(c.Row, "B")
            Range("H38") = .Cells(c.Row, "C")
            Range("M50") = .Cells(c.Row, "D")
            Range("AQ50") = .Cells(c.Row, "E")
        End If
    End With
    
    Application.ScreenUpdating = True
 
End Sub

Sayfa şifreli olduğu için "sayın" kısmına bakamadım.

.

 

[muttabomer]

Ömer hocam dediğiniz gibi ekledim, yine aynı hatayı veriyor.
ben Mac Os kullandığım için uzantısı xlsm
Makroyu çalıştırınca fatura numarasını yazıyorum,
ActiveWorkbook.Sheets("FATURA").Copy gelince hatayı veriyor.

Sayfanın şifresi 1 hocam

 

[Ömer]

FileFormat:=52

52 değerini 53 yaparak dener misiniz.

------------------------------------------------------------

H24 deki doğrulama için formül:

=KAYDIR('TÜM FİRMALAR'!$A$7;;
 ;BAĞ_DEĞ_DOLU_SAY('TÜM FİRMALAR'!$A$7:$A$65000))

.

 

[muttabomer]

Ömer hocam yine olmadı,

Neyse bu şekilde devam edeyim size de zahmet verdim.
Hakkınızı Helal Edin!...