• DİKKAT

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

2011 den 2016 ya geçişte makro sorunu

A

azizcarman

Katılım
11 Ocak 2016
Mesajlar
13
Excel Vers. ve Dili
excell 2011 mac ingilizce
şimdiden teşekkürler

kendime yeni bir excel dosyası hazırldım daha bitmedi ancak office 2011 den 2016 ya geçtim ürünü aldım

ancak makrolarım tam anlamıyla çalışmıyor

makrolarım şu şekilde dosyamın anasayfasında birkaç tuş var bunlara macrolar atanmış durumda örneğin şu dosyayı aç şu sütundaki veriyi kopyala kapat asıl kullanılan dosyaya yapıştır gibi
2011 de bu komutlar çalışıyor ancak 2016 da hata veriyor eski yaptığım şekilde makro kaydet dediğimde başka bir dosyayı açtığımda buda makro kodlarında çıkmıyor


Sub musterikayit()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'
' musterikayit Macro
'

'
Range("C2:C7").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Open Filename:="KINGSTON:musteri.xlsm"
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Range("C2:C7").Select
Selection.ClearContents
Range("C2").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


örnek kod
 
Yapmak istediğiniz kapalı dosyadan veri almak. Örnek dosyalarınızı eklerseniz yardımcı olmaya çalışalım.
Yada F8 ile kodları satır satır çalıştırın, hata veren yer neresi kontrol edin. (Workbooks.Open Filename:="KINGSTON:musteri.xlsm" olabilir. Dosya yolunu bulamadığı için)
 
ben macro yazma konusunda çok iyi olmadığımdan macroları makro kayıt ile yapıyorum ve hepsini 2011 kullanarak yaptım 2016 da açılmıyor

yani ben makro kayda basıp bir dosyayı açınca orda bir işlem yapınca kaydı durdurunca o kodlar çıkıyor ancak 2016 da aynı işlemi yapınca başka dosya açınca yani makro kayıt sanki öyle birşey yapmamışım gibi hareket ediyor

http://www.dosyaupload.com/2sJB



askm' Alıntı:
Yapmak istediğiniz kapalı dosyadan veri almak. Örnek dosyalarınızı eklerseniz yardımcı olmaya çalışalım.
Yada F8 ile kodları satır satır çalıştırın, hata veren yer neresi kontrol edin. (Workbooks.Open Filename:="KINGSTON:musteri.xlsm" olabilir. Dosya yolunu bulamadığı için)
Genişletmek için tıkla ...
 
Workbooks.Open Filename:="KINGSTON:finans.xlsm" olan kodlarınızı Workbooks.Open Filename:=ThisWorkbook.Path & "\finans.xlsm" şeklinde değiştirin.
 
dediğiniz şekilde yaptım oldu hazır yakalamışken bir sıkıntım daha var onada yardım edebilirseniz çok memnun olurum

bu formülle sayıyı para birimine çevirdiğimde formülde olduğundaki gibi türkçe karakterler çıkmıyor buna bir çözümünüz varmı acaba

Function tl_yaz(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
textbox1.Font.Name = "calibri"
a = Array("", "bir", "iki", "].", "dšrt", "be_", "altõ", "yedi", "sekiz", "dokuz")
b = Array("", "On", "Yirmi", "Otuz", "Kõrk", "Elli", "Altmõ_", "Yetmi_", "Seksen", "Doksan")
c = Array("", "", "Bin", "Milyon", "Milyar", "Trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sõfõr"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "YŸz", "BirYŸz", "YŸz")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 6) = "BirBin" Then son = Replace(son, "BirBin", "Bin")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then tl = son & " TŸrkLirasõ"
If g = 2 And deger(2) <> 0 Then kr = " " & son & " Kuru_"
son = ""
e = 0
Next
tl_yaz = tl & kr
End Function


askm' Alıntı:
Workbooks.Open Filename:="KINGSTON:finans.xlsm" olan kodlarınızı Workbooks.Open Filename:=ThisWorkbook.Path & "\finans.xlsm" şeklinde değiştirin.
Genişletmek için tıkla ...
 
Aşağıdaki fonksiyonu kullanın.
=ParaCevir(A1) şeklinde yazacaksınız.
Kod: 
Public Function ParaCevir(Para) 
    Dim ParaStr As String 
    Dim Lira As String, Kurus As String 
    
    If Not IsNumeric(Para) Then GoTo SayiDegil 
    
    ParaStr = Format(Abs(Para), "0.00") 
    
    Lira = Left(ParaStr, Len(ParaStr) - 3) 
    Kurus = Right(ParaStr, 2) 
    
    ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş" 
    
    Exit Function 
    
SayiDegil: 
    ParaCevir = "GİRİLEN DEÐER SAYI DEÐİL!" 
End Function 

Private Function Cevir(SayiStr As String) As String 
    Dim Rakam(15) 
    Dim c(3), Sonuc, e 
    
    Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz") 
    Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan") 
    Binler = Array("trilyon", "milyar", "milyon", "bin", "") 
    
    SayiStr = String(15 - Len(SayiStr), "0") + SayiStr 
    
    For i = 1 To 15 
      Rakam(i) = Val(Mid$(SayiStr, i, 1)) 
    Next i 
    
    Sonuc = "" 
    For i = 0 To 4 
      c(1) = Rakam(i * 3 + 1) 
      c(2) = Rakam(i * 3 + 2) 
      c(3) = Rakam(i * 3 + 3) 
      If c(1) = 0 Then 
        e = "" 
      ElseIf c(1) = 1 Then 
        e = "yüz" 
      Else 
        e = Birler(c(1)) + "yüz" 
      End If 
      e = e + Onlar(c(2)) + Birler(c(3)) 
      If e <> "" Then e = e + Binler(i) 
      If (i = 3) And (e = "birbin") Then e = "bin" 
      Sonuc = Sonuc + e 
    Next i 

    If Sonuc = "" Then Sonuc = "Sıfır" 
    
    Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1) 
End Function
 
Sayın askm;

Fonksiyon çalışıyor ancak; Kuruşsuz yazılan değerlerde sıfır kuruş yazısı çıkyor. Bunu kaldıramazmıyız?
 
Aşağıdaki şekilde ufak bir ekleme yaptım.

Kod: 
Public Function ParaCevir(Para)
    Dim ParaStr As String
    Dim Lira As String, Kurus As String
    
    If Not IsNumeric(Para) Then GoTo SayiDegil
    
    ParaStr = Format(Abs(Para), "0.00")
    
    Lira = Left(ParaStr, Len(ParaStr) - 3)
    Kurus = Right(ParaStr, 2)
    If Kurus = 0 Then
    ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira "
    Else
        ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş"
    End If
    Exit Function
    
SayiDegil:
    ParaCevir = "GİRİLEN DEÐER SAYI DEÐİL!"
End Function

Private Function Cevir(SayiStr As String) As String
    Dim Rakam(15)
    Dim c(3), Sonuc, e
    
    Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
    Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
    Binler = Array("trilyon", "milyar", "milyon", "bin", "")
    
    SayiStr = String(15 - Len(SayiStr), "0") + SayiStr
    
    For i = 1 To 15
      Rakam(i) = Val(Mid$(SayiStr, i, 1))
    Next i
    
    Sonuc = ""
    For i = 0 To 4
      c(1) = Rakam(i * 3 + 1)
      c(2) = Rakam(i * 3 + 2)
      c(3) = Rakam(i * 3 + 3)
      If c(1) = 0 Then
        e = ""
      ElseIf c(1) = 1 Then
        e = "yüz"
      Else
        e = Birler(c(1)) + "yüz"
      End If
      e = e + Onlar(c(2)) + Birler(c(3))
      If e <> "" Then e = e + Binler(i)
      If (i = 3) And (e = "birbin") Then e = "bin"
      Sonuc = Sonuc + e
    Next i

    If Sonuc = "" Then Sonuc = "Sıfır"
    
    Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function
 
çok teşekkürler sayende programı ilerletiyorum


askm' Alıntı:
Aşağıdaki şekilde ufak bir ekleme yaptım.

Kod: 
Public Function ParaCevir(Para)
    Dim ParaStr As String
    Dim Lira As String, Kurus As String
    
    If Not IsNumeric(Para) Then GoTo SayiDegil
    
    ParaStr = Format(Abs(Para), "0.00")
    
    Lira = Left(ParaStr, Len(ParaStr) - 3)
    Kurus = Right(ParaStr, 2)
    If Kurus = 0 Then
    ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira "
    Else
        ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş"
    End If
    Exit Function
    
SayiDegil:
    ParaCevir = "GİRİLEN DEÐER SAYI DEÐİL!"
End Function

Private Function Cevir(SayiStr As String) As String
    Dim Rakam(15)
    Dim c(3), Sonuc, e
    
    Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
    Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
    Binler = Array("trilyon", "milyar", "milyon", "bin", "")
    
    SayiStr = String(15 - Len(SayiStr), "0") + SayiStr
    
    For i = 1 To 15
      Rakam(i) = Val(Mid$(SayiStr, i, 1))
    Next i
    
    Sonuc = ""
    For i = 0 To 4
      c(1) = Rakam(i * 3 + 1)
      c(2) = Rakam(i * 3 + 2)
      c(3) = Rakam(i * 3 + 3)
      If c(1) = 0 Then
        e = ""
      ElseIf c(1) = 1 Then
        e = "yüz"
      Else
        e = Birler(c(1)) + "yüz"
      End If
      e = e + Onlar(c(2)) + Birler(c(3))
      If e <> "" Then e = e + Binler(i)
      If (i = 3) And (e = "birbin") Then e = "bin"
      Sonuc = Sonuc + e
    Next i

    If Sonuc = "" Then Sonuc = "Sıfır"
    
    Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function
Genişletmek için tıkla ...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst