sajt u izradi..
English French German Italian Portuguese Russian Spanish
Izrada cena [ECR TOOL baza][EXCEL makro][Source File]
Created: Monday, 19.August.2013. 17:17
'
'Kešelj Branislav 2010
'
'
Sub load_file()
    Dim t As Integer
    Dim db As Variant
    t = Application.WorksheetFunction.CountA(Columns("A:A"))
    Range("A5:C" & (t + 5)).Select
    Selection.ClearContents
    db = Range("B4").Value
    If (db = "") Then
        With Application
            db = .GetOpenFilename("Excel Files (*.csv),*.csv,", 0, "Select a File to Open")
        End With
        If db = False Then
            MsgBox "No file was selected."
            Exit Sub
        Else
            Range("B4").Value = db
            ActiveWorkbook.Save
        End If
    End If
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & db, Destination:=Range("$A$5"))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("C:C,D:D,F:F,G:G,H:H").Select
    Selection.Delete Shift:=xlToLeft
    Rows("5:5").Select
    Selection.Delete Shift:=xlUp
    Range("A:A").ColumnWidth = 7
    Range("B:B").ColumnWidth = 70
    Range("C:C").ColumnWidth = 15
    Range("D5").Select
End Sub
Sub mp_select()
Dim t As Integer
Dim naziv As Variant
Dim sifra As Variant
Dim cena As Variant
    Selection.Copy
    Sheets("template").Select
    Range("A5").Select
    ActiveSheet.Paste
    t = Application.WorksheetFunction.CountA(Columns("A:A"))
    If t > 0 Then
        sifra = Range("A5:A" & (t + 5)).Value
        naziv = Range("B5:B" & (t + 5)).Value
        cena = Range("C5:C" & (t + 5)).Value
        Selection.Clear
        Call engine(sifra, naziv, cena, t, 0)
    Else
        Sheets("main").Select
    End If
End Sub
Sub clear_all()
    Dim t As Integer
    t = Application.WorksheetFunction.CountA(Columns("A:A"))
    Range("A5:C" & (t + 5)).Select
    Selection.ClearContents
    Range("B4").Value = ""
    Range("A1").Select
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
            If p = 1 Then
                Range("E1:G3").Select
                Selection.Copy
            End If
            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
            If p = 1 Then
                Range("A1,D1,G1").Select
            Else
                Range("A1").Select
            End If
            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