Skip to main content

AccessTr.neT


Puantaj Makro Çalışması

Puantaj Makro Çalışması

Çözüldü #1
Öncelikle kolay gelsin yazdığım kodlamalar ile Puantaj Hazırlama sayfasında kayıt alma ve verileri geri getirme sorunu yaşamıyorum. Farklı bir pc aktardığım zaman Set wb = Workbooks.Open(dosya) bu kısımda hata alıyorum. Kendi bilgisayarımda bu hatayı almıyorum.

Mesai kısmında puantajdaki gibi kayıt yapmak istiyorum Örneğin Excel Dosyasının adı Eylül Mesai 2021 gibi ama onda ise aynı kodları kullanmama rağmen Aktarilacak veri yok. hatası alıyorum bir türlü çözemedim verileri geri getiremiyorum.
.rar Puataj.rar (Dosya Boyutu: 199,49 KB | İndirme Sayısı: 27)
Cevapla
#2
sorun çıkaran diğer dosyayı da ekler misiniz?
bu haliyle bir çözüm önermek zor

dosyanızı indirip kodu çalıştırdım dosyayı kendisi oluşturup veri ekledi
Cevapla
#3
Merhaba.
Kodu alttaki gibi değiştirin.
Son sütun no tam bulunamıyor kodda birleştirmeden dolayı galiba.
Ben Const sonSutun As String = "AY" olarak ekleme yaptım gerekirse değiştirin orayı.

Private Sub CommandButton2_Click() 'kaydet

Dim son As Long, son2 As Long, i As Long, syfAra As Worksheet
Dim wb As Workbook, ws As Worksheet, dosya As String, say As Integer
Dim d31 As String, e13 As String, yol As String
Dim sonSutun As Integer
yol = ""
Const basSatir As Integer = 41
Const secim As Integer = 31
Const ilksutun As Integer = 6
Const sonSutun As String = "AY"

d31 = Range("D31").Value
e13 = Range("E13").Value


son2 = Cells(Rows.Count, 1).End(3).Row
If son2 < basSatir Then GoTo son

For i = basSatir To son2
'    If Not IsNumeric(Cells(i, 1).Value) Then: son = i - 1: Exit For
    If Val(Cells(i, 1).Value) = 0 Then: son = i - 1: Exit For
Next

'dosya = ThisWorkbook.Path & Application.PathSeparator & e13 & ".xlsx"
dosya = ThisWorkbook.Path & Application.PathSeparator & Format(e13, "Mesai mmmm yyyy") & ".xlsx"
'dosya = yol & Application.PathSeparator & Format(e13, "mmmm yyyy") & ".xlsx"

say = 0
        If Dir(dosya) = "" Then 'Klasörde E13 deki veri ile ayni isimde Excel yoksa
            If kontroluzunluk(d31) = True Then GoTo son
            Set wb = Workbooks.Add
            Set ws = wb.Sheets(1)
            ws.Name = d31
        Else 'Klasörde E13 deki veri ile ayni isimde Excel yokvarsasa
            Set wb = Workbooks.Open(dosya)
            For Each syfAra In wb.Worksheets
              If syfAra.Name = d31 Then
                  say = say + 1
                  Exit For
              End If
            Next
       
            If say = 0 Then 'Kapali excelde D31 deki adla ayni isimd sayfa yoksa
                If kontroluzunluk(d31) = True Then GoTo son
                wb.Sheets.Add
                Set ws = wb.ActiveSheet
                ws.Name = d31
            Else 'Kapali excelde D31 deki adla ayni isimd sayfa varsa
                Set ws = wb.Worksheets(d31)
            End If
        End If

ThisWorkbook.Activate

Application.DisplayAlerts = False
ws.Cells.Clear
Range(Cells(secim, "A"), Cells(son, sonSutun)).Copy ws.Range("A1")
Range(Cells(secim, "A"), Cells(son, sonSutun)).Copy
ws.Range("A1").PasteSpecial xlPasteColumnWidths
ws.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats

wb.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & Format(e13, "Mesai mmmm yyyy") & ".xlsx"
'wb.SaveAs Filename:=yol & Application.PathSeparator & Format(e13, "mmmm yyyy") & ".xlsx"
wb.Close

Application.CutCopyMode = False
Set wb = Nothing: Set ws = Nothing
Application.DisplayAlerts = True
son:

Application.CutCopyMode = False
Set wb = Nothing: Set ws = Nothing
Application.DisplayAlerts = True
End Sub
Cevapla
#4
İş yerinde olan bilgisayarım da sadece Set wb= workbooks.Open(dosya) kısmında sorun yaşıyorum ama bu Excel ile kendi şahsi bilgisayarımda bu sorunu yaşamıyorum. Bu sorun Puantaj hazırlama sayfasındaki puantaj kaydet butonunda oluyor bu Excel size atsam sizin PC çalışacak ama burada neden çalışmıyor anlamış değilim. Kaydettiği Excel girdiğimde Puantaj Nisan 2020.xlsx içindeki bazı öğelerde bir sorunla karşılaştık diyor daha sonra kapatırken kaydediyorum ve başka bir tesisin punatajını yapıyorum aynı Excel alıyor girdiğimde aynı hata veriyor kaydediyorum bu şekilde çalışıyor. Şahsi bilgisayarımda öyle değil otomatik olarak kayıt yapıyor sayfa sayfa .
Cevapla
#5
İş yerinde bulunan PC ofis standart evde bulunan PC professional bundan kaynaklı olduğunu düşünüyorum. İlk kaydettiği Excel açamıyor çünkü şu hatayı onarıyor /xl/worksheets/sheet1.xml. Açamadığı için içine yeni bir kayıt yapamıyor. Bunu nasıl düzeltme bilirim.
Cevapla
#6
Öncelikle adım adım incelemek gerekebilir kullandığınız office sürümleri nedir? ms kütüphanesi ile alakalı bir durum olabilir. Ayrıca kullandığınız officede makroları vs. Devredışı bırak gibi özellikleride kontrol ettiniz mi?
Son Düzenleme: 17/12/2021, 12:31, Düzenleyen: lemoncher2.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task