dosyayı otomatik read only açtırmak.

MOONROSE · 26 Ocak 2006

Merhaba 2 dosyam var. Rapor dosyamda hazırlanmış bir pivot table var ve command buton var.Command butona basıldığında önce taban isimli dosyayı açıyor sonra rapor dosyasındaki pivot table refresh ediyor ve pivot table hazırlıyor sonra taban dosyasını kapatıyor. Sorun şu ki, datanın olduğu dosya "C:\Documents and Settings\Administrator\Desktop\taban\TABAN 10.01.06 rev.2.xls" bir başkasında açık ise doğal olarak okunabilir açmak için soru soruyor. Benim amacım bu soruyu ortadan kaldırmak ve kullanıcının kafasını karıştırmamak. Fakat bukadarını macro recorder ile beceremedim. Kendisi read only olarak açsın (dosyanın kullanıldığı bilgisayarlar WinXP ve office türkçe).Mümkün müdür acaba?aşağıdaki kodlarıda önce recorder ile yapıp sonra değiştirdim bu yüzden biraz karışık oldu galiba

zamanla öğreneceğim.

Kod:

Sub Makro10()
'DOSYA AÇMA
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\Administrator\Desktop\taban\TABAN 10.01.06 rev.2.xls"
    ActiveWindow.DisplayWorkbookTabs = True
    Sheets("U.IS EMRI LISTESI").Select
    Windows("TABAN RAPORLAR3.xls").Activate
'PİVOT DATA REFRESH
    ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotCache.Refresh
    
    
'kriter sayfasındaki datalara göre pivot

Sheets("Mus_toplam_adet_rap").Select
    Range("D10").Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotFields("MÜÃTERİ")
        .Orientation = xlRowField
        .Position = 1
        

    End With
    
          
kritersip = Sheets("kriterler").Range("a3").Value
kritersevk = Sheets("kriterler").Range("a4").Value
kriterkalan = Sheets("kriterler").Range("a5").Value

'sipariş toplamı.................................................................
    ActiveSheet.PivotTables("Ã?zet Tablo 2").AddDataField ActiveSheet.PivotTables( _
        "Ã?zet Tablo 2").PivotFields(kritersip), "SİPARİÃ", xlCount

'sevk edilen.....................................................................
    ActiveSheet.PivotTables("Ã?zet Tablo 2").AddDataField ActiveSheet.PivotTables( _
        "Ã?zet Tablo 2").PivotFields(kritersevk), "SEVK", xlCount

 'kalan........................................................................
    ActiveSheet.PivotTables("Ã?zet Tablo 2").AddDataField ActiveSheet.PivotTables( _
        "Ã?zet Tablo 2").PivotFields(kriterkalan), "KALAN_SEVK", xlCount
   
   
    'SİPARİÃ % SÜTUNU EKLEME..........................................
      ActiveSheet.PivotTables("Ã?zet Tablo 2").AddDataField ActiveSheet.PivotTables( _
        "Ã?zet Tablo 2").PivotFields(kritersip), "SİPARİÃ %", xlCount
      
   'sipariş toplamı.
       Range("B2").Select
    ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotFields("SİPARİÃ"). _
        Function = xlSum
   'sevk edilen
    Range("B2").Select
    ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotFields("SEVK"). _
        Function = xlSum
  'kalan..
    Range("B2").Select
    ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotFields("KALAN_SEVK"). _
        Function = xlSum
   
   
 'SİPARİÃ % SÜTUNU EKLEME..........................................

    Range("E5").Select
    With ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotFields("SİPARİÃ %")
        .Calculation = xlPercentOfColumn
        .NumberFormat = "0%"
    End With
    Columns("E:E").Select
    Selection.NumberFormat = "0%"
    Range("E1").Select
    

   
   'sipariş toplamına göre sortla
      
          Range("A3").Select
    ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotFields("MÜÃTERİ").AutoSort _
        xlDescending, "SİPARİÃ"
    
    'BOÃ VERİLERİ VERME
        With ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotFields("MÜÃTERİ")
        .PivotItems("(boş)").Visible = False
    End With
    
    'formatı için
        Sheets("Mus_toplam_adet_rap").Select
    Range("A4").Select
    ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotSelect "", xlDataAndLabel, True
    ActiveSheet.PivotTables("Ã?zet Tablo 2").Format xlReport4
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
    End With
        Sheets("Mus_toplam_adet_rap").Select
    Columns("B:E").Select
    Selection.ColumnWidth = 12
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
          End With
        Rows("4:4").Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
        Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
 
    Selection.ColumnWidth = 30.86
    Range("A2:D2").Select
   
      
   
   'BAÃLIK SATIRI............................................................
       Range("A2:E2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "FİRMA BAZINDA KÜMÜLATİF SİPARİÃ RAPORU"

    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Kalın"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 47
    End With
    Rows("2:2").Select
    Selection.RowHeight = 15
    Range("A15").Select
    
    'BORDER İÇİN....................................................................
    Range("C7").Select
    ActiveSheet.PivotTables("Ã?zet Tablo 2").PivotSelect "", xlDataAndLabel, True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDot
        .Weight = xlThin
        .ColorIndex = 48
    End With
    
   
    ActiveWorkbook.ShowPivotTableFieldList = False

'TABAN DOSYASINI KAPAMA.........................................................
       Windows("TABAN 10.01.06 rev.2.xls").Activate
     '  Workbooks("TABAN.xls").Close SAVECHANGES:=False
   ActiveWindow.Close SAVECHANGES:=False
      Windows("TABAN RAPORLAR3.xls").Activate

    End Sub

MOONROSE · 26 Ocak 2006

bu istediğim mümkün değil mi acaba?vakti olan birisi ilgilenebilirse çok sevinirim.

Haluk · 26 Ocak 2006

[vb:1:68306aefd0]Workbooks.Open Filename:= _
"C:\Documents and Settings\Admini.......... 10.01.06 rev.2.xls", ReadOnly:=True[/vb:1:68306aefd0]

MOONROSE · 30 Ocak 2006

çok teşekkür ederim.

dosyayı otomatik read only açtırmak.

MOONROSE

MOONROSE

Haluk

Özel Üye

MOONROSE