Raporlanan Sayfaların Yedeğini Almada Problem

onurcan1979 · 23 Ekim 2020

Önceden bu kodu kullanıyordum çok ta güzel çalışıyordu şimdi bu koddan yedek alamıyorum

Özel Alt CommandButton11_Click ()
Uygulama ile
.ScreenUpdating = Yanlış
.EnableEvents = Yanlış
.DisplayAlerts = Yanlış
İle bitmek

git = ActiveSheet.Name
Klasor = ThisWorkbook.Path & "\ RAPOR \"

Hatada Devam Et Sonraki
Dir (Klasor) = "" O zaman MkDir Klasor

Dim ds, bir
Ds = CreateObject ("Scripting.FileSystemObject") ayarlayın
Dim Sayfa Çalışma Sayfası

Dim myArray () Değişken Olarak
Tamsayı Olarak Dim i
Tamsayı Olarak Dim j
j = 0
İ = 1 To Sheets.Count için
r = 0
Sayfalar (i) .Name = "KONTEYNER.GİRİŞ" ise
r = 1
ElseIf Sheets (i) .Name = "DEPO.ÇIKIŞ.RAPOR" Sonra
r = 1
ElseIf Sheets (i) .Name = "KAPALI.DEPO.GİRİŞ" O halde
r = 1
ElseIf Sheets (i) .Name = "K.DEPO.ÇIKIŞ.RAPOR" Sonra
r = 1

Bitiş Eğer

R = 1 ise
ReDim myArray'i Koru (j)
myArray (j) = i
j = j + 1
Bitiş Eğer

Sonraki ben
E-Tablolar (myArray).
E-Tablolar (myArray) .Copy

İ = 1 To Len için (ThisWorkbook.Name)
Mid (ThisWorkbook.Name, i, 1) = ".xlsx" ise
Dosya_adi = Orta (ThisWorkbook.Name, 1, i - 1)
uzanti = Orta (ThisWorkbook.Name, i, Len (ThisWorkbook.Name))
Bitiş Eğer
Sonraki

CreateObject'teki ("Scripting.FileSystemObject") Her Dosya İçin GetFolder (Klasor) .Files
Orta (Dosya.Adı, 1, Len (Dosya_adi)) = Dosya_adi Sonra
oturdu = oturdu + 1
a = ds.FileExists (Klasor & "\" & Dosya_adi & sat & uzanti)
Eğer a = Doğru O zaman
Başka
Oğlu = 1
Çıkış
Bitiş Eğer
Bitiş Eğer
Sonraki

Oğul = 0 ise O zaman
oturdu = oturdu + 1
Bitiş Eğer

deger = Dosya_adi & otur & uzanti

İ = 1 için ActiveWorkbook.Sheets.Count'a

ActiveWorkbook.Sheets (Sheets (i] .Name).
Dim X Aralık Olarak
Her X Giriş için [A1: K30]
Eğer X.Value <> "" O zaman
X.Value = X.Value
Bitiş Eğer
Sonraki X
Sonraki
ActiveWorkbook.Sheets (Sheets (1] .Name).

ActiveWorkbook.SaveAs Klasor & "\" & deger
ActiveWorkbook.Close SaveChanges: = Yanlış
E-Tablolar (git).
Uygulama ile
.ScreenUpdating = Doğru
.EnableEvents = Doğru
.DisplayAlerts = Doğru
İle bitmek
MsgBox Klasor & "\" & deger & Chr (10) & Chr (10) & _
"Kayıt yapıldı", vbInformation, deger

Sub

onurcan1979 · 23 Ekim 2020

Iyi aksamlar

onurcan1979 · 24 Ekim 2020

Günaydın

onurcan1979 · 24 Ekim 2020

Bu şekilde rapor alabileceğim baska kod var mi?

Korhan Ayhan · 25 Ekim 2020

Merhaba,

Foruma kod eklerken mesaj yazdığınız pencerede üç nokta şeklinde görünen bir seçenek olması gerekiyor. Ona tıklayarak kodu paylaşınız. Bu şekilde daha düzgün görünecektir.

Eklediğiniz kodların bazı kısımları Türkçe olarak görünüyor. Sanırım foruma eklerken sorun oluştu.

onurcan1979 · 26 Ekim 2020

Gunaydin Üstadlar bana yardim edecek yol gösterecek birivarmi?

onurcan1979 · 26 Ekim 2020

Korhan Ayhan' Alıntı:
Merhaba,

Foruma kod eklerken mesaj yazdığınız pencerede üç nokta şeklinde görünen bir seçenek olması gerekiyor. Ona tıklayarak kodu paylaşınız. Bu şekilde daha düzgün görünecektir.

Ekli dosyayı görüntüle 222194

Eklediğiniz kodların bazı kısımları Türkçe olarak görünüyor. Sanırım foruma eklerken sorun oluştu.

Hocam sayfayı yenileme den msj atmışım kusurabakmayin yeni gördüm msjnizi

onurcan1979 · 26 Ekim 2020

Kod:

Private Sub CommandButton11_Click()
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

git = ActiveSheet.Name
Klasor = ThisWorkbook.Path & "\RAPOR\"

On Error Resume Next
If Dir(Klasor) = "" Then MkDir Klasor

Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
Dim Sayfa As Worksheet

Dim myArray() As Variant
Dim i As Integer
Dim j As Integer
j = 0
For i = 1 To Sheets.Count
r = 0
If Sheets(i).Name = "KONTEYNER.GİRİŞ" Then
r = 1
ElseIf Sheets(i).Name = "DEPO.ÇIKIŞ.RAPOR" Then
r = 1
ElseIf Sheets(i).Name = "KAPALI.DEPO.GİRİŞ" Then
r = 1
ElseIf Sheets(i).Name = "K.DEPO.ÇIKIŞ.RAPOR" Then
r = 1

End If

If r = 1 Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If

Next i
Sheets(myArray).Select
Sheets(myArray).Copy

For i = 1 To Len(ThisWorkbook.Name)
If Mid(ThisWorkbook.Name, i, 1) = ".xlsx" Then
Dosya_adi = Mid(ThisWorkbook.Name, 1, i - 1)
uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
End If
Next


For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).Files
If Mid(Dosya.Name, 1, Len(Dosya_adi)) = Dosya_adi Then
sat = sat + 1
a = ds.FileExists(Klasor & "\" & Dosya_adi & sat & uzanti)
If a = True Then
Else
Son = 1
Exit For
End If
End If
Next


If Son = 0 Then
sat = sat + 1
End If

deger = Dosya_adi & sat & uzanti


For i = 1 To ActiveWorkbook.Sheets.Count

ActiveWorkbook.Sheets(Sheets(i).Name).Select
Dim X As Range
For Each X In [A1:K30]
If X.Value <> "" Then
X.Value = X.Value
End If
Next X
Next
ActiveWorkbook.Sheets(Sheets(1).Name).Select

ActiveWorkbook.SaveAs Klasor & "\" & deger
ActiveWorkbook.Close SaveChanges:=False
Sheets(git).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
MsgBox Klasor & "\" & deger & Chr(10) & Chr(10) & _
"Kayıt yapıldı", vbInformation, deger

End Sub

Korhan Ayhan · 26 Ekim 2020

Bu kod şimdi çalışmıyor mu? Hata mı veriyor?

Yani sorun nedir?

Örnek dosyanızı ekleyerek yapmak istediğiniz işlemi açıklarsanız bizde daha net cevaplar verebiliriz.

onurcan1979 · 26 Ekim 2020

Korhan Ayhan' Alıntı:
Bu kod şimdi çalışmıyor mu? Hata mı veriyor?

Yani sorun nedir?

Örnek dosyanızı ekleyerek yapmak istediğiniz işlemi açıklarsanız bizde daha net cevaplar verebiliriz.

Kod islemini yaptığını söylüyor ama yedeğini alamiyorum

onurcan1979 · 26 Ekim 2020

onurcan1979' Alıntı:
Kod islemini yaptığını söylüyor ama yedeğini alamiyorum

Hata vermiyor. Yedek alınmıştır diyor ama ortada yedek yok

onurcan1979 · 29 Ekim 2020

Korhan Ayhan' Alıntı:
Bu kod şimdi çalışmıyor mu? Hata mı veriyor?

Yani sorun nedir?

Örnek dosyanızı ekleyerek yapmak istediğiniz işlemi açıklarsanız bizde daha net cevaplar verebiliriz.

Ustadim baka bilginizmi? Sorun nerden kaynaklaniyor

Korhan Ayhan · 29 Ekim 2020

Dediğim gibi örnek dosyanızı paylaşıp yapmak istediğiniz işlemi açıklayınız. Bana sanki daha kısa kodlama ile istediğiniz yapılabilir gibi geldi.

onurcan1979 · 22 Kasım 2020

Korhan Ayhan' Alıntı:
Dediğim gibi örnek dosyanızı paylaşıp yapmak istediğiniz işlemi açıklayınız. Bana sanki daha kısa kodlama ile istediğiniz yapılabilir gibi geldi.

merhaba hocam ben ufak bir çalışma yaptım ama şuan için yetersiz bazı problemler var. öncelikli problem alınan raporun yedeğinin alınması.

kullanıcı adı: ADMIN şifre : 1234

onurcan1979 · 24 Kasım 2020

Korhan Ayhan' Alıntı:
Dediğim gibi örnek dosyanızı paylaşıp yapmak istediğiniz işlemi açıklayınız. Bana sanki daha kısa kodlama ile istediğiniz yapılabilir gibi geldi.

Korhan hocam iyi akşamlar

Korhan Ayhan · 24 Kasım 2020

Eklediğiniz dosyada hangi sayfa nereye nasıl yedeklenecek?

onurcan1979 · 25 Kasım 2020

Korhan Ayhan' Alıntı:
Eklediğiniz dosyada hangi sayfa nereye nasıl yedeklenecek?

Günaydın Üstadım UserForm5 te rapor alma bölümü var. CommandButton10 " Toplu yedek al" butonu Raporlanan sayfaları Ayri bir Excel kitabi olarak yedeğini alacak. Depo Envanter kitabından (KONTEYNER.GİRİŞ, DEPO.ÇIKIŞ.RAPOR, KAPALI.DEPO.GİRİŞ, K.DEPO.ÇIKIŞ.RAPOR, TCDD.VAGON.RAPOR, DEPO.ENVANTER.MEVCUT, DEPO.ENVANTER.RAPOR, PERSONEL.RAPOR, ARAÇ.TAKİP, ARAÇ.ARIZA, ARAÇ.RAPOR, YAKIT.KAYIT, YAKIT.RAPOR) SAYFALARI BIR OLARAK AYRI BIR KITAP SAYFASI SEKLINDE KAYIDININ ALINMASINI ISTIYORUM. BU GUNLUK FALIYET RAPOR OLACAK. Birde bölümlere göre rapor yedeği almak istiyorum.

Korhan Ayhan · 25 Kasım 2020

Yedeklenen dosyanın adı ve uzantısı ne olacak?

onurcan1979 · 25 Kasım 2020

Korhan Ayhan' Alıntı:
Yedeklenen dosyanın adı ve uzantısı ne olacak?

Depo Envanter rapor ve tarih

Korhan Ayhan · 25 Kasım 2020

Deneyiniz.

C++:

Private Sub CommandButton10_Click()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    Klasor = ThisWorkbook.Path & "\Yedek"
    Dosya_Adi = Klasor & "\Depo Envanter Raporu - " & Date & ".xlsx"
    
    On Error Resume Next
    If Dir(Klasor) = "" Then MkDir Klasor
    On Error GoTo 0
    
    Sheets(Array("KONTEYNER.GİRİŞ", "DEPO.ÇIKIŞ.RAPOR", "KAPALI.DEPO.GİRİŞ", "K.DEPO.ÇIKIŞ.RAPOR", _
                 "TCDD.VAGON.RAPOR", "DEPO.ENVANTER.MEVCUT", "DEPO.ENVANTER.RAPOR", "PERSONEL.RAPOR", _
                 "ARAÇ.TAKİP", "ARAÇ.ARIZA", "ARAÇ.RAPOR", "YAKIT.KAYIT", "YAKIT.RAPOR")).Copy
    
    ActiveWorkbook.SaveAs Dosya_Adi, 51
    ActiveWorkbook.Close SaveChanges:=False
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    MsgBox "Veriler aşağıdaki klasöre yedeklenmiştir." & Chr(10) & Chr(10) & Dosya_Adi
End Sub

Raporlanan Sayfaların Yedeğini Almada Problem

onurcan1979

onurcan1979

onurcan1979

onurcan1979

Korhan Ayhan

Administrator

onurcan1979

onurcan1979

onurcan1979

Korhan Ayhan

Administrator

onurcan1979

onurcan1979

onurcan1979

Korhan Ayhan

Administrator

onurcan1979

Ekli dosyalar

onurcan1979

Korhan Ayhan

Administrator

onurcan1979

Korhan Ayhan

Administrator

onurcan1979

Korhan Ayhan

Administrator