Új hozzászólás Aktív témák

• #6411 mr.nagy tag

  Új Válasz 2010-03-01 13:41:46 #6411

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  mr.nagy

  tag

  Sziasztok!

  Van egy makro kódom ami a következőképpen néz ki:

  Private Sub CommandButton1_Click()
  
  
  
  Dim ws As Worksheet
  Set ws = Worksheets("akció")
  
  'év ellenőrzés
  If Trim(Me.TextBox1.Value) = "" Then
  MsgBox "Nincs megadva az év!"
  Exit Sub
  End If
  'szám ellenőrzés
  If Trim(Me.TextBox2.Value) = "" Then
  MsgBox "Nincs megadva az akció száma!"
  Exit Sub
  End If
  
  'adatok rögzítése a táblába
  
  ws.Cells(1, 2).Value = Me.TextBox1.Value 'év
  ws.Cells(2, 2).Value = Me.TextBox2.Value 'szám
  
  'kiürítés
  Me.TextBox1.Value = ""
  Me.TextBox2.Value = ""
  
  
  'kijelölt mező
  Me.TextBox1.SetFocus
  
  
  Unload UserForm1
  
  Sheets("Munka1").Activate
  Sheets("Munka1").Range("A6").Select
  Selection.QueryTable.Refresh BackgroundQuery:=False
  
  Sheets("Munka2").Activate
  Sheets("Munka2").Range("A1").Select
  Selection.QueryTable.Refresh BackgroundQuery:=False
  
  Sheets("Munka3").Activate
  Sheets("Munka3").Range("A1").Select
  Selection.QueryTable.Refresh BackgroundQuery:=False
  
  Sheets("Munka3").Activate
  Sheets("Munka3").Range("M4").Select
  ActiveSheet.PivotTables("Kimutatás2").PivotCache.Refresh
  
  Sheets("akció").Activate
  Sheets("akció").Range("C5").Select
  ActiveSheet.PivotTables("Kimutatás3").PivotCache.Refresh
  
  Cells.Select
  Selection.Copy
  Workbooks.Add
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  Range("G6").Select
  ActiveWindow.FreezePanes = True
  
  Rows("5:5").Select
  With Selection
  .VerticalAlignment = xlBottom
  .WrapText = True
  .Orientation = 0
  .AddIndent = False
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False
  End With
  Columns("G:DB").Select
  Selection.ColumnWidth = 7.71
  Range("CX4:DB4").Select
  Range("DB4").Activate
  With Selection
  .HorizontalAlignment = xlLeft
  .VerticalAlignment = xlBottom
  .WrapText = True
  .Orientation = 1
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False
  End With
  With Selection.Font
  .Name = "Arial"
  .Size = 8
  .Strikethrough = False
  .Superscript = False
  .Subscript = False
  .OutlineFont = False
  .Shadow = False
  .Underline = xlUnderlineStyleNone
  .ColorIndex = 1
  End With
  Range("CX4:DB4").Select
  With Selection
  .HorizontalAlignment = xlLeft
  .VerticalAlignment = xlBottom
  .WrapText = True
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False
  End With
  Rows("5:5").Select
  Selection.AutoFilter
  Application.CutCopyMode = False 'a pillanatnyi kijelölést szünteti meg'
  Application.DisplayAlerts = False
  
  
  Windows("akcio-minden-aruhaz").Activate
  ActiveWindow.Close
  Application.DisplayAlerts = True
  
  
  End Sub
  
  Private Sub CommandButton2_Click()
  Unload UserForm1
  End Sub

  Bizonyos számítógépeken a következő hiba üzenetet kapom:
  Run-time error'9':
  Subscript out of range

  Érdekes, hogy nem minden gépen jön elő a hiba üzenet. Ha a debugra kattintok a következő sort jelöli ki: ActiveWindow.Close

  Tudnátok segíteni, mi lehet a gond és hogyan javítható ki?!

Új hozzászólás Aktív témák