home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 December (Special) / PCWorld_2002-12_Special_cd.bin / Special_komplet / special_komplet.exe / Prazdne_Radky.bas < prev    next >
BASIC Source File  |  2002-01-03  |  2KB  |  57 lines
  1. Attribute VB_Name = "Prazdne_Radky"
  2. Sub Kopirovani_Prazdnych_Bunek()
  3. Application.ScreenUpdating = False
  4. f = Selection.FormatConditions.Count
  5. If f = 3 Then
  6.     MsgBox "Prßv∞ jste pou₧il ji₧ t°i druhy formßtu!"
  7.     m = False
  8.     GoTo OhneFormat
  9. End If
  10.     Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
  11.         Formula1:="="""""
  12.     Selection.FormatConditions(f + 1).Interior.ColorIndex = 5
  13.     m = True
  14. OhneFormat:
  15. Antwort = MsgBox("Chcete zkopφrovat data?", vbYesNo + vbQuestion + vbDefaultButton1)
  16.     If Antwort = vbYes Then    '
  17.         z = 1
  18.     Vorlage = ActiveSheet.Name
  19.     ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
  20.     Name = InputBox("Zadejte jmΘno pro nov² list", , "PrßzdnΘ bu≥ky")
  21.     ActiveSheet.Name = Name
  22.     Sheets(Vorlage).Select
  23.         zeile = Selection.Row
  24.         endzeile = Selection.Rows.Count
  25.     For Each r In Selection.Rows
  26.        For Each c In r.Cells
  27.         If c.Value = "" Then
  28.             Rows(zeile).Copy
  29.             Worksheets(Name).Select
  30.             Rows(z).Select
  31.             Selection.PasteSpecial Paste:=xlFormats
  32.             Selection.PasteSpecial Paste:=xlValues
  33.             Sheets(Vorlage).Select
  34.             z = z + 1
  35.             GoTo Ende
  36.         End If
  37. Next
  38. Ende:
  39.  If zeile + 1 <= endzeile Then
  40.     zeile = zeile + 1
  41. Else
  42.     zeile = Selection.Row
  43. End If
  44.    Next
  45.      Sheets(Vorlage).Select
  46.    If m Then
  47.         Selection.FormatConditions(f + 1).Delete
  48.     End If
  49.         Application.CutCopyMode = False
  50. End If
  51. Application.ScreenUpdating = True
  52. End Sub
  53.  
  54.  
  55.  
  56.  
  57.