- Katılım
- 18 Ağustos 2009
- Mesajlar
- 741
- Excel Vers. ve Dili
- Office Ev ve İş 2021 - Türkçe
- Altın Üyelik Bitiş Tarihi
- 12-12-2024
Arkadaşlar kullanmış olduğum dosyamda bazı macrolar var ancak nedendir bilmiyorum sayfamda bulunan koşullu biçimlendirmeler her seferinde siliniyor. Bu neden olabilir acaba? Kullandığım en önemli macroları sizinle paylaşmak istedim. Bunların arasında sorunlu olan olabilirmi?
Bu macro ile sayfayı çoğaltma yapıyorum
Private Sub ÇOĞALT_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For k = 1 To Application.Sheets.Count
If IsNumeric(Sheets(k).Name) Then
sayisal = sayisal + 1
Else
harf = harf + 1
End If
Next k
Tespit = InputBox("Gün", "Tespit")
For i = sayisal To Tespit + sayisal - 1
Sheets(CStr(sayisal)).Select
Sheets(CStr(sayisal)).Copy Before:=Sheets(1)
Sheets(1).Name = i + 1
Sheets(1).Range("j1") = Sheets("1").Range("j1") + i
Sheets(1).Range("H3:I7,L3:M7,H9:I13,L9:M13,H15:I19,L15:M19,H28:I33,L28:M33,H35:I41,L35:M41,H78:I90,H97:I102,H109:I151").ClearContents
Sheets(1).Range("J1").Select
ActiveWindow.SmallScroll Down:=-3
Next i
For j = 1 To Application.Sheets.Count - harf
On Error Resume Next
Sheets(CStr(j)).Select
Sheets(CStr(j)).Move Before:=Sheets(j)
Next j
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Bunlarla da 20 dk kullanılmadığında otomatik kaydederek kapatılmasını sağlıyorum
workbook kodu
Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not IsEmpty(CloseDownTime) Then
Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
End If
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cells.FormatConditions.Delete
End Sub
modül kodu
Option Explicit
Public CloseDownTime As Variant
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:20:00") ' hh:mm:ss
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub
Public Sub CloseDownFile()
On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=True
End Sub
Bu macro ile sayfayı çoğaltma yapıyorum
Private Sub ÇOĞALT_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For k = 1 To Application.Sheets.Count
If IsNumeric(Sheets(k).Name) Then
sayisal = sayisal + 1
Else
harf = harf + 1
End If
Next k
Tespit = InputBox("Gün", "Tespit")
For i = sayisal To Tespit + sayisal - 1
Sheets(CStr(sayisal)).Select
Sheets(CStr(sayisal)).Copy Before:=Sheets(1)
Sheets(1).Name = i + 1
Sheets(1).Range("j1") = Sheets("1").Range("j1") + i
Sheets(1).Range("H3:I7,L3:M7,H9:I13,L9:M13,H15:I19,L15:M19,H28:I33,L28:M33,H35:I41,L35:M41,H78:I90,H97:I102,H109:I151").ClearContents
Sheets(1).Range("J1").Select
ActiveWindow.SmallScroll Down:=-3
Next i
For j = 1 To Application.Sheets.Count - harf
On Error Resume Next
Sheets(CStr(j)).Select
Sheets(CStr(j)).Move Before:=Sheets(j)
Next j
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Bunlarla da 20 dk kullanılmadığında otomatik kaydederek kapatılmasını sağlıyorum
workbook kodu
Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not IsEmpty(CloseDownTime) Then
Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
End If
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cells.FormatConditions.Delete
End Sub
modül kodu
Option Explicit
Public CloseDownTime As Variant
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:20:00") ' hh:mm:ss
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub
Public Sub CloseDownFile()
On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=True
End Sub