otomatik makro çalıştırma ve otomatik dosya ismi

S

serdenm

Katılım
17 Şubat 2006
Mesajlar
117
Merhabalar,

1. bir makro yazdim ve makroyu buton a atadim ve sorunsuz calisiyor. bu makronun excel dosyasinin acilisinda otomatik olarak calismasini (butona basmadan ve her hangi bir uyari vermeden) istiyorum. access te autoexec gibi biseyle halledilebiliyordu sanirim.

2. ikinci bir sorum ise bir butona her basisimda dosyayi farkli kaydeden bir makro. dosyalar soyle olmali: deneme1.xls deneme2.xls vb... ve eğer dixinde önceden kaydedilmis deneme2.xls varsa otomatik olarak deneme3.xls yapmali. cozumu simdilik asagidaki gibi yaptim:
ActiveWorkbook.SaveAs ("c:\piyasalar " & Range("'ana menu'!f1"))

burada F1 hucresi= şimdi() ve devamli degistigi icin bir problem olmuyor. fakat ben otomatik sayaç olmasını istiyorum. 1,2,3,4,5 vs.
TESEKKURLER.
 
K

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Öncelikle Forumumuza Hoş Geldiniz.

1.sorunuzun Cevabı :

[vb:1:14f1419ec1]Sub auto_open()
.
.
.
.
kodlar
.
.
.
End Sub[/vb:1:14f1419ec1]
2.sorunuzun Cevabı

[vb:1:14f1419ec1]Range("f1").value=Range("f1").value+1[/vb:1:14f1419ec1]

[vb:1:14f1419ec1]Sub birartır()
Range("f1").value=Range("f1").value+1
End sub[/vb:1:14f1419ec1]
 
A

algil

Katılım
28 Nisan 2005
Mesajlar
252
Excel Vers. ve Dili
Excel 2010 Türkçe
Sn. Serdenm
Örnek bir dosya gönderebilir misiniz?
 
S

serdenm

Katılım
17 Şubat 2006
Mesajlar
117
Rakkas, Hoşbulduk. Cevabın için çok teşekkür ederim.

Algil dosyayi birazdan gonderecegim.

Forum çok kaliteli, emeği geçen herkese teşekkür ederim.
 
K

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Sn.Serdem,

Bir Şey Sormamda Sakınca yok ise,

Vermiş Oldugum Cevap İşinize yaramadı mı?

Kolay Gelsin.
 
S

serdenm

Katılım
17 Şubat 2006
Mesajlar
117
Merhaba Rakkas,

auto_open işime yaradı.
otomatik dosya (veya worksheet) ismi için hücreyi bir artırmak ta güzel bir çözüm. fakat deneme1, deneme2 v.s devam ederken örneğin deneme1 i sildiğimde yeni kayıt edilecek olan tekrar deneme1 olabilir mi? (yani olmayanların yerine geçme).

ayrıca bir sorum daha belirdi: auto open ile çalıştırdığım makro dış veri alıp farklı kaydedip workbook u kapatiyor. yeni farklı kaydedilen dosyada dogal olarak ayni islemi yapmak istior. onun yerine yeni kaydettigim dosyada sadece veriler olsun ve makro otomatik çalışmasın.

dosyayi gonderemiyorum. sirketteki firewall izin vermiyor. :(
umarim aciklayici olabilmisimdir. anlasilmayan bisey varsa aciklayabilirim.
tesekkurler.
 
S

serdenm

Katılım
17 Şubat 2006
Mesajlar
117
Sub ser6()

End Sub
Dim Sayfa As Worksheet



Range("E1").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False





Set Sayfa = ThisWorkbook.Worksheets.Add
'Sayfa.Name = Worksheets("fonlar buton").Range("h6")



Range("B1").Select
ActiveCell.FormulaR1C1 = "=now()"



Range("B1").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select


Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Range("A1").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 5
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial Tur"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
Range("B1").Select
Selection.Font.ColorIndex = 2

Range("c1").Select
ActiveCell.FormulaR1C1 = "=today()"


Application.CutCopyMode = False
Selection.Copy
Range("d1").Select


Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Selection.Font.ColorIndex = 2
Range("c1").Select
Selection.Font.ColorIndex = 2




Sayfa.Name = "piyasalar " & Range("'ana menu'!f1")




Sheets("piyasalar " & Range("'ana menu'!f1")).Select
Sheets("piyasalar " & Range("'ana menu'!f1")).Move after:=Sheets(2)









a = MsgBox("Veriler internetten alınırken lütfen bekleyiniz. Bağlantı hızına göre bekleme süresi değişebilir.", vbOKOnly, "SERDEN")




With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.akbank.com/fiyat_oranlar/index.asp?page=2009", Destination:= _
Range("A2"))
.Name = "index.asp?page=2009"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "11"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.akbank.com/yatirimci.asp", Destination:= _
Range("g38"))
.Name = "yatirimci"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With


With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.akbank.com/fiyat_oranlar/index.asp?page=2021", Destination:= _
Range("k2"))
.Name = "index.asp?page=2021"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With




Range("A40").Select
ActiveCell.FormulaR1C1 = ""
Range("A35").Select
ActiveCell.FormulaR1C1 = ""
Range("A1").Select
Columns("A:A").EntireColumn.AutoFit

Range("A27:G36").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True

Range("G12:I26").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True
Range("G4:I10").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True

Range("G47:G51").Select
Range("G51").Activate
Selection.ClearContents
Range("H38:J41").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True
Range("G43").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True

Range("A1").Select

Columns("B:B").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.SmallScroll ToRight:=9

Range("L2:R17").Select
Application.CutCopyMode = False
Selection.Copy

Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Range("L2:S21").Select
Selection.ClearContents




Range("E27:I36").Select
Application.CutCopyMode = False
Selection.Copy

Range("B27").Select
ActiveSheet.Paste
Range("G27:I36").Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Range("F27:F36").Select
Selection.Copy
Range("E27").Select
ActiveSheet.Paste
Range("F27:F36").Select
Application.CutCopyMode = False
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone

'genel piyasalar:

Range("I38:K41").Select
Selection.Copy
Range("a19").Select
ActiveSheet.Paste

Range("H43").Select
Application.CutCopyMode = False
Selection.Copy
Range("a21").Select
ActiveSheet.Paste
Range("H38:L43").Select
Application.CutCopyMode = False
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone




Range("H4:J26").Select
Selection.Copy
Range("G19").Select
ActiveSheet.Paste

Range("J4:K26,H4:I18").Select

Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Cells.Select
Range("D1").Activate
Cells.EntireColumn.AutoFit

Range("A39").Select
Selection.ClearContents
Columns("A:A").EntireColumn.AutoFit

Range("A18:C18").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2:G17").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True
Range("A2:G3").Select
Selection.Interior.ColorIndex = 5
Selection.Font.ColorIndex = 6
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("I31").Select

Range("I27:I36").Select
Selection.Cut
Range("H27").Select

Range("H2:H17").Select
Selection.Interior.ColorIndex = xlNone

Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select

ActiveWorkbook.SaveAs ("c:\piyasalar " & Range("'ana menu'!f1"))
Application.Quit

End Sub
 
S

serdenm

Katılım
17 Şubat 2006
Mesajlar
117
az once yazmis oldugum ser6 isimli macro yu copy paste yaptim. bunu auto open olarak otomatik yaptiriyorum. sonunda kayit farkli ettigi dosyada auto open olmasin istiyorum. cunku bu sefer o dasyada ayni seyi yapiyor ve sonsuz dongu gibi birsey oluyor.
umarim aciklayabilmisimdir... :eek:k::
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst