sajt u izradi..
English French German Italian Portuguese Russian Spanish
Izrada cena [EXCEL makro][Source File]
Created: Monday, 19.August.2013. 17:28
'
'Kešelj Branislav 2012
'
'
Sub a____load_file()
Dim Filter As String
Dim FilterIndex As Integer
Dim Filename As Variant
    Filter = "Excel Files (*.xls),*.xls," & _
    "Excel Files (*.xlsx),*.xlsx,"
    With Application
        Filename = .GetOpenFilename(Filter, 0, "Select a File to Open")
    End With
    If Filename = False Then
        MsgBox "No file was selected."
        Exit Sub
    End If
    Workbooks.Open Filename
    t = Application.WorksheetFunction.CountA(Columns("A:A"))
    If t > 0 Then
        Range("A1:C" & t).Select
        Selection.Copy
        ActiveWindow.Close
        Range("A5").Select
        ActiveSheet.Paste
        Range("A5").Select
    Else
        MsgBox "EMPTY file"
        ActiveWindow.Close
    End If
End Sub
Sub b____all_price()
Dim t As Integer
Dim naziv As Variant
Dim sifra As Variant
Dim cena As Variant
    t = Application.WorksheetFunction.CountA(Columns("A:A"))
    If t > 0 Then
        item_num = Range("A5:A" & t + 4).Value
        item_name = Range("B5:B" & t + 4).Value
        item_price = Range("C5:C" & t + 4).Value
        Call engine(item_num, item_name, item_price, t, 0)
    End If
End Sub
Private Sub engine(item_num, item_name, item_price, t, b)
        Dim c As Double
        Dim r_min As Integer
        Dim r_max As Integer
        Dim limit As Integer
        Dim row As Integer
        Dim col As String
        Dim item_price_  As Variant
        limit = 240
        c = t / limit
        If (c > Int(c)) Then c = Int(c) + 1
        For p = 1 To c
            Sheets("Main").Select
            Range("E1:G3").Select
            Selection.Copy
            Sheets.Add
            Range("A:A,D:D,G:G").ColumnWidth = 4.43
            Range("B:B,E:E,H:H").ColumnWidth = 17.14
            Range("C:C,F:F,I:I").ColumnWidth = 8.72
            Rows(1).RowHeight = 26.25
            Rows(2).RowHeight = 30
            Rows(3).RowHeight = 36
            Range("A1,D1,G1").Select
            ActiveSheet.Paste
            If p * limit <= t Then
            r_max = limit
            r_min = p * limit - limit
            Else
            r_min = (p - 1) * limit
            r_max = t - r_min
            End If
            row = 1
            For i = 1 To r_max
                Select Case i Mod 3
                    Case Is = 1
                        col = "C"
                        If (i + 3) Mod 3 = 1 And (i + 3) <= r_max Then
                            Rows(i & ":" & i + 2).Select
                            Selection.Copy
                            Rows(i + 3 & ":" & i + 3).Select
                            ActiveSheet.Paste
                        End If
                        row = row + 3
                    Case Is = 2
                        col = "F"
                    Case Else
                        col = "I"
                End Select
                If b = 0 Then
                    If t > 1 Then
                        Range(col & row - 3).Value = item_num(i + r_min, 1)
                        Range(col & row - 3).Offset(1, -2).Value = item_name(i + r_min, 1)
                        item_price_ = Split(item_price(i + r_min, 1), ".")
                    Else
                        Range(col & row - 3).Value = item_num
                        Range(col & row - 3).Offset(1, -2).Value = item_name
                        item_price_ = Split(item_price, ".")
                    End If
                    Range(col & row - 3).Offset(2, -1).Value = Range(col & row - 3).Offset(2, -1).Value & item_price_(0)
                    If (UBound(item_price_) - LBound(item_price_) + 1) = 2 Then
                        If Len(item_price_(1)) = 1 Then
                            Range(col & row - 3).Offset(2, 0).Value = "." & item_price_(1) & "0 " & Range(col & row - 3).Offset(2, 0).Value
                        Else
                            Range(col & row - 3).Offset(2, 0).Value = "." & item_price_(1) & " " & Range(col & row - 3).Offset(2, 0).Value
                        End If
                    Else
                        Range(col & row - 3).Offset(2, 0).Value = ".00 " & Range(col & row - 3).Offset(2, 0).Value
                    End If
                End If
             Next i
        Next p

    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.53)
        .RightMargin = Application.InchesToPoints(0.23)
        .TopMargin = Application.InchesToPoints(0.18)
        .BottomMargin = Application.InchesToPoints(0.67)
        .HeaderMargin = Application.InchesToPoints(0.17)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .FitToPagesWide = False
        .FitToPagesTall = False
    End With
End Sub


 

Post a comment
0
Comments | Add yours
  • No comments found
Free visitor tracking, live stats, counter, conversions for Joomla, Wordpress, Drupal, Magento and Prestashop