خرید بک لینک

Vote count: 0

I'm having trouble with this code:

Sub pRINTA_IZVJESTAJ_GORIVA()

' ' PRINTA_IZVJESTAJ_GORIVA Macro ' On Error GoTo AkoGRESKA 'Ovo ako se klikne negdje van raspona a odabere se printer("V1") If ActiveCell.Column() > 21 Or ActiveCell.Row() > 61 Or ActiveCell.Row() = 1 _ Or ActiveCell.Value = "" Then MsgBox " K R I V I R A S P O N !" & vbNewLine & " " & vbNewLine & _ " ILI NEMA PODATAKA ZA ISPIS !", 64, "" GoTo AkoGRESKA Else Application.EnableEvents = False Dim MSG As String, ANS As Variant MSG = " ŽELITE LI ISPISATI IZVJEŠTAJ ULAZA?" & " " & _ Range("A" & ActiveCell.Row) & " " & Range("C" & ActiveCell.Row) ANS = MsgBox(MSG, vbQuestion + vbYesNo + vbDefaultButton2, "Ispis izvještaja") Select Case ANS Case vbYes Application.ScreenUpdating = False Application.DecimalSeparator = "," Application.ThousandsSeparator = "." Application.UseSystemSeparators = False

        Range("A" & ActiveCell.Row).Select
        Selection.Copy
        Sheets("List2").Select
        Range("C4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("B" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("C6").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("C" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("C7").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("E" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("D" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("K9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("F" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("F16").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("G" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("H14").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("H" & ActiveCell.Row & ":K" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("G12").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("L" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("F18").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("M" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("F19").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("N" & ActiveCell.Row & ":Q" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("G13").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("R" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("F17").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("S" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("F21").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("T" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("F22").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("List1").Select
        Range("U" & ActiveCell.Row).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("List2").Select
        Range("H16:J19").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll DOWN:=-30
        Range("A1:L30").Select
        Application.CutCopyMode = False

'        U slučaju da nema printera:
        On Error Resume Next
        Application.Dialogs(xlDialogPrinterSetup).Show
        Selection.PrintOut Preview:=True
        On Error GoTo 0

        Application.ScreenUpdating = False

        Range("H16:J19").Select
        Selection.ClearContents
        Range("F22").Select
        Selection.ClearContents
        Range("F21").Select
        Selection.ClearContents
        Range("F19").Select
        Selection.ClearContents
        Range("F18").Select
        Selection.ClearContents
        Range("F16:F17").Select
        Range("F17").Activate
        Selection.ClearContents
        ActiveWindow.SmallScroll DOWN:=-18
        Range("G12:J14").Select
        Selection.ClearContents
        Range("K9").Select
        Selection.ClearContents
        Range("C9").Select
        Selection.ClearContents
        Range("C7").Select
        Selection.ClearContents
        Range("C6").Select
        Selection.ClearContents
        Range("C4").Select
        Selection.ClearContents
        Sheets("List1").Select
        ActiveWindow.SmallScroll ToLeft:=12
        Range("A1").Select

        Application.UseSystemSeparators = True

        Case vbNo
        GoTo QUIT:
        End Select

AkoGRESKA: End If Application.EnableEvents = True Exit Sub QUIT: Application.EnableEvents = True End Sub

asked 15 secs ago

برچسب: نویسنده: استخدام کار تاريخ: شنبه 19 تير 1395 ساعت: 0:24

صفحه بندی