Hirdetés

2017. augusztus 23., szerda

Gyorskeresés

Útvonal

Fórumok  »  Szoftverfejlesztés  »  Visual Basic

Hozzászólások

(#2851) alexy92 válasza Ispy (#2850) üzenetére


alexy92
(fanatikus tag)

Szia,

Sajnos nem vagyok még expert, így tudnál segíteni a változóban? Illetve a változó minden sub elejére kell?
Azt látom, ott ahol hibára futok, oda kell majd berakjam az on error goto VÁLTOZÓ. ÉS a változóban lesz majd az iferror, a subok elején meg az Iserror-t false-á teszem.

Köszi!

(#2852) sztanozs válasza alexy92 (#2849) üzenetére


sztanozs
(PH! addikt)
LOGOUT blog

próbáld meg így:
If Err Then

Esetleg lehetne egy Err.Clear az On Error Resume Next előtt...
Amúgy nem lehet, hogy Selection.Copy mindig hibát dob neked? Asszem talán akkor is hibát dob, ha nem az aktív lapon van a Selection...

[ Szerkesztve ]

JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...

(#2853) alexy92 válasza sztanozs (#2852) üzenetére


alexy92
(fanatikus tag)

Szia,

Délután meg tudom próbálni. selection.copy-nak kell hibát dobnia, mert van amikor üres amit másolok, és akkor ugye az egész sheetet másolná ki (1004-es hiba), de van amikor van benne adat, ugye akkor másolni kéne, és folytatni a sub-ot.

(#2854) Ispy válasza alexy92 (#2851) üzenetére


Ispy
(PH! addikt)

Nem nagyon programoztam még excelben, szóval az én elképzelésem:

Dim IsError as boolean

Private Sub Main -> a fő kódod, gondolom valamilyen eventre fut le az egész cucc

On Error GoTo ErrHandling

valami kód, amit írtál és mindig gebasz van vele...

IF IsError = True Then
Call Sub2
Else
Call Sub3
End IF

valami kód, amit írtál és mindig gebasz van vele...

IF IsError = True Then
Call Sub4
Else
Call Sub5
End IF

exit sub

ErrHangling:
IsError = True
Resume

End Sub

Private Sub Sub2
IsError = False
....

End Sub

Persze lehet ezt még finomítani kell, kb. 5 éve nem nyúltam VBA kódhoz, de kb. így csinálnám. A subokat el is lehet hagyni, csak akkor van értelme külön kódba kiemelni, ha több helyen is használod ugyanazt a kódot.

Ha mondjuk egész kódrészleteket beraknál ide, akkor nagyobb eséllyel tudunk hibát keresni mi is....

Három fajta ember van. Aki tud számolni, és aki nem.

(#2855) alexy92 válasza Ispy (#2854) üzenetére


alexy92
(fanatikus tag)

Sub All()
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Columns("K:K").Select
Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("A:A").Select
Range("L1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-1],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Radler")
LR = Range("K" & Rows.Count).End(xlUp).Row
Range("L1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$L").AutoFilter Field:=12, Criteria1:= _
"Not in file"
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
CevaBelgium
Else
VKtrans
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("D1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("I" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("D1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("G1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Range("K1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "RADLER KFT."
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Radler").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("L").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate


End Sub

Sub VKtrans()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Columns("A:A").Select
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("V1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("V2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-21],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("VK Transport")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("V1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$V").AutoFilter Field:=22, Criteria1:= _
"Not in file"
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
DSVROADNV
Else
CevaBelgium
End If
Windows("invoices_masterfile.xlsm").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate

With Sheets("VK Transport")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("O2").End(xlDown).Offset(0, 2).Select
Range("Q2", "Q" & LR).Select
End With
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "VK Transport"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("VK Transport").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("V:V").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate



End Sub
Sub CevaBelgium()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Columns("A:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.Value = "Invoice Date"
Range("B1").Select
ActiveCell.Value = "Service Date"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=Date(Left(RC[3],4),mid(RC[3],5,2),right(RC[3],2))"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=iferror(Date(Left(RC[20],4),mid(RC[20],5,2),right(RC[20],2)),RC[-1])"
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("CJ1").Select
ActiveCell.Value = "Check if its in the masterfile"
Range("CJ2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-85],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Ceva Belgium")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("CJ1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$CJ").AutoFilter Field:=88, Criteria1:= _
"Not in file"
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
Azkar
Else
DSVROADNV
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate

Range("AN1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate

Range("AN1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("AL1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "CEVA FREIGHT BELGIUM N.V."
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Ceva Belgium").Activate
Range("1:1").Select
Selection.AutoFilter
Columns("CJ:CJ").Select
Selection.Delete Shift:=xlToLeft
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate



End Sub


Sub DSVROADNV()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("S1").Select
ActiveCell.Value = "Check if its in the masterfile"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=Iferror(match(RC[-18],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("DSV Road")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("S1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$S").AutoFilter Field:=19, Criteria1:= _
"Not in file"
Range("b1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
DachserBE
Else
Azkar
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("b1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("I" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("L1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
With Sheets("DSV Road")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("M2").End(xlDown).Offset(0, 1).Select
Range("N2", "N" & LR).Select
End With
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "DSV ROAD N V"
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[4])"
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=month(RC[3])"
Range("E" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=Isoweeknum(RC[3])"
Range("F" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("DSV Road").Activate
Rows("1:1").Select
Selection.AutoFilter
Columns("S").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate



End Sub

Sub Azkar()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("P:P").Select
Selection.TextToColumns Destination:=Range("P1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("Z1").Select
ActiveCell.Value = " Check if its in the matserfile"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-25],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Azkar")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("Z1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$Z").AutoFilter Field:=26, Criteria1:= _
"Not in file"
Range("O1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
DachserHU
Else
DachserBE
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Range("O1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("N1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("N1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
With Sheets("Azkar")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("O2").End(xlDown).Offset(0, 1).Select
Range("P2", "P" & LR).Select
End With
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("K" & Rows.Count).End(xlUp).Offset(1, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "TRANSPORTES AZKAR, S.A"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Azkar").Activate
Range("1:1").Select
Selection.AutoFilter
Columns("Z:Z").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate


End Sub

Sub DachserBE()
Selection.Clear
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser BE").Activate
Range("S1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("s2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-2],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
Range("t1").Select
ActiveCell.Value = "Date"
Range("t2").Select
ActiveCell.FormulaR1C1 = "=date(right(RC[-19],4),mid(RC[-19],4,2),left(RC[-19],2))"
With Sheets("Dachser BE")
LR = Range("Q" & Rows.Count).End(xlUp).Row
Range("S1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("T1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$M").AutoFilter Field:=19, Criteria1:= _
"Not in file"
Range("T1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
WaberersINT
Else
DachserHU
End If
Windows("raw_invoice_riports.xlsx").Activate
Windows("invoices_masterfile.xlsm").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Windows("raw_invoice_riports.xlsx").Activate
Selection.End(xlUp).Select
Range("P1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Windows("raw_invoice_riports.xlsx").Activate
Selection.End(xlUp).Select
Range("P1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("F1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("M" & Rows.Count).End(xlUp).Offset(0).Select
ActiveCell.Offset(1, -1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Range("Q1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.Offset(0, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("F" & Rows.Count).End(xlUp).Offset(1).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "DACHSER TRANSPORT BELGIE"
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[4])"
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=month(RC[3])"
Range("E" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=Isoweeknum(RC[3])"
Range("F" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
ActiveSheet.Range("1:1").AutoFilter
Windows("raw_invoice_riports.xlsx").Activate
Rows("1:1").Select
Selection.AutoFilter
Columns("S:T").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate



End Sub
Sub DachserHU()
On Error GoTo 0
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("AJ1").Select
ActiveCell.Value = "Check if its in the masterfile"
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-2],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Dachser HU")
LR = Range("AH" & Rows.Count).End(xlUp).Row
Range("AJ1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$AJ").AutoFilter Field:=36, Criteria1:= _
"Not in file"
Range("V1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy

Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("V1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
If Err.Number <> 0 Then
Vege
Else
WaberersINT
End If
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("W1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("W1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("D1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("K" & Rows.Count).End(xlUp).Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Range("AH1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "LIEGL & DACHSER SZALLITMANYOZASI ES"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Dachser HU").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("AJ").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate





End Sub
Sub WaberersINT()
Selection.Clear
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Columns("A:A").Select
Range("J1").Select
ActiveCell.Value = "Check if its in masterfile"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MATCH(RC[-8],[invoices_masterfile.xlsm]main!C13,0),""Not in file"")"
With Sheets("Waberers INT")
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("J1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Range("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$J").AutoFilter Field:=10, Criteria1:= _
"Not in file"
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
On Error Resume Next
Selection.Copy
If Err.Number <> 0 Then
Vege
Else
Vege
End If
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("F1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1, -1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("F1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("J" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Range("B1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[1],vendor_codes!C1:C2,2,0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "WABERERS INTERNATIONAL ZRT"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Year(RC[4])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Month(RC[3])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=isoweeknum(RC[2])"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=vlookup(RC[-2],MOR!C1:C2,2,0)"
Range("K" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-5]"
With Sheets("main")
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("A1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("B1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("C1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("D1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("E1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("F1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
Range("K1").End(xlDown).Offset(0, 0).Activate
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(LR, ActiveCell.Column))
End With
Windows("raw_invoice_riports.xlsx").Activate
Worksheets("Waberers INT").Activate
Rows("1:1").Activate
Selection.AutoFilter
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate

End Sub

Sub Vege()
Selection.Clear
MsgBox "Siker!", vbExclamation
End
End Sub

Így lenne, és a többit már tudjátok :)

[ Szerkesztve ]

(#2856) sztanozs válasza alexy92 (#2855) üzenetére


sztanozs
(PH! addikt)
LOGOUT blog

Úbaszki, mi ez a kódkígyó... :Y

Semmi indent, egy csomó tök feleslges sor.

[ Szerkesztve ]

JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...

(#2857) alexy92 válasza sztanozs (#2856) üzenetére


alexy92
(fanatikus tag)

örülök ha megy, első nagyobb macro-m amit önszorgalomból írok :B

(#2858) sztanozs válasza alexy92 (#2857) üzenetére


sztanozs
(PH! addikt)
LOGOUT blog

Első körben a felesleges Select és Activate sorokat vedd ki:
- két (vagy több) select egymás után felesleges, csak az utolsó maradjon meg (kiváve, ah a következőben fel van használva a selection, de ezeket inkább egy sorba kell tömöríteni
- aktív sheet-et vagy workbook-ot újra aktiválni felesleges
- a valami.Select + Selected.Value = ... felesleges, helyette valami.Value = ... elég, nem kell kijelölni, ráadásul gyorsabb is
- ha nem Select-tel dolgozol, hanem közvetlen referenciával, akkor nem kell Activate és Select:
Workbooks("Workbook.xls").Worksheet("Sheetnév").Range("CellaReferencia").Value = "valami"
- Copy/PasteSpecial:value helyett sokkal (!) gyorsabb az Array copy: [link]

[ Szerkesztve ]

JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...

(#2859) alexy92 válasza sztanozs (#2858) üzenetére


alexy92
(fanatikus tag)

Köszi! A finomítás majd akkor lesz ha kész lesz a mechanika :B

(#2860) sztanozs válasza alexy92 (#2859) üzenetére


sztanozs
(PH! addikt)
LOGOUT blog

Könnyebb kódot egyszerűbb javítani.

JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...

(#2861) alexy92 válasza sztanozs (#2860) üzenetére


alexy92
(fanatikus tag)

Jelenleg örülnék, ha a mechanika összejönnie, de tényleg. :((

(#2862) Ispy válasza alexy92 (#2855) üzenetére


Ispy
(PH! addikt)

:Y

Na, a feladat a következő: ezt az egészet mentsed el, tedd félre. Nincs az az isten, hogy tapasztalat nélkül ebbe a kóddzsungelben bármit is megtaláljál.

Utána kezd el 0-ról, apránként, minimális kóddal. Ha megy, akkor adjál hozzá még egy részt, és így tovább. Ha nem megy, akkor állj meg és akkor térjünk vissza rá.

Három fajta ember van. Aki tud számolni, és aki nem.

(#2863) alexy92 válasza Ispy (#2862) üzenetére


alexy92
(fanatikus tag)

Az összes lefut, ha van olyan sor amit másolni kell(ergo nincs 1004-es kód, a másik fájlban van olyan adat amit még ebben nincs), hibátlanul :P

[ Szerkesztve ]

(#2864) Ispy válasza alexy92 (#2863) üzenetére


Ispy
(PH! addikt)

Ezt megcsináltad? Minden subrutinba rakd be az Err.Clear-t, mert szerintem amikor hiba után bemegy egy hiba sub-ba, akkor megtartja az eredeti hiba értékét és ezért a 2. körben is a hiba sub-ba fog menni, annak ellenére, hogy ott nincsen hiba.

Szóval minden sub elejére rakjad be, hogy Err.Clear....

Három fajta ember van. Aki tud számolni, és aki nem.

(#2865) Delila_1 válasza alexy92 (#2861) üzenetére


Delila_1
(PH! kedvence)

A bemásolt tengeri kígyóban ilyen részletek vannak:

Range("C1").Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("invoices_masterfile.xlsm").Activate
Worksheets("main").Activate
Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False

Select utasítások nélkül

usor = Range("C1").End(xlDown).Row
Range("C2:C" & usor).Copy
With Workbooks("invoices_masterfile.xlsm").Sheets("main")
usor = .Range("H" & Rows.Count).End(xlUp).Row + 1
.Range("H" & usor).PasteSpecial Paste:=xlPasteValues
End With

Látod, az usor változót felhasználtam a másoláshoz. Az adatok már ott csücsülnek a vágólapon, a másik füzet egyik lapján új értéket rendelhetek hozzá, jelen esetben a H oszlop első üres sorának a számát.
A Select utasítások ráállnak az adott füzet adott lapjára, ott is bizonyos cellá(k)ra. Ez időveszteség, ráadásul ugrál a kép.

Végül

If Err.Number <> 0 Then
sub3
Else
On Error GoTo 0
sub2
End If

Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

(#2866) PETEE78


PETEE78
(fanatikus tag)

Sziasztok!

Outlook2013 Inbox beérkező levelek küldő, tárgy, dátum, esetleg méret adatait szeretném kigyűjteni egy excel munkalapra. Nyilván a Ctrl+c volna a legegyszerűbb... :D
Ezt hogy lehet vb-ben megírni? Mondjuk adott, hogy az adott excel is már meg van nyitva illetve nyilván az Outlook is.

Vagy esetleg csak a fent említett adatokat 1db txt file-ba lementeni?

Ha útmutatót adnátok milyen parancsokkal induljak el, nekem az is megfelel.

Segítségeteket előre is köszönöm!

"nuku tőtike" és megvan a 60fps :)

(#2867) martonx válasza alexy92 (#2859) üzenetére


martonx
(PH! addikt)

Ezzel a hozzá állással születnek, az örökre úgy hagyott undormányok.

Én kérek elnézést!

(#2868) lorcsi


lorcsi
(PH! kedvence)

kellene egy komolyabb help

a suliban visual studiot használok az otthoni acc-ommal
írtunk egy progit és csak az ottani hálóra mentettem el, de jó lenen a hétvégéán itthon is csinálni
szerintetek a háttérben accomra feltöltötte vajon?
létezik iylen?

[ Szerkesztve ]

(#2869) Bazs87


Bazs87
(tag)

Sziasztok!

Érdekes problémával találtam magam szembe:

Feladat:
van egy laza 25ezer soros német-lengyel fordításom, ami egy programból (Siemens TIA Portal) lett exportálva. A "text"manipulálás után szeretném visszatölteni ezt. Persze az új verzió egy libből kikeresve lefordítja amit letud (szakmai szöveg, nem érdemes összekötni semmilyen értelmes fordítóval, max ha gálvölgyi show-t és elégedetlen ügyfelet akarunk)

Megoldási elv(eddig):
létrehoztam egy vbs ole kapcsolatot excellel. (ne kérdezzétek miért, nekem komfortosabb így, mint az excel makrófelületével dolgozni)
A program megnyitja a szótár excelt és az A oszlop elemei lesznek a key-ek, B oszlop azonos sorainak elemei pedig az adatok.
Excel becsuk, új doku kinyit és egy sima compare után beírogatom a lengyel verziót. Ezután elmentem és mindenki boldog....

Probléma:
a txt sorai és az excel cellák tartalma nem azonos szintaxúak -> tele vannak a cellákon belüli "értékek"/adatok sortöréssel.
Erre felkészültem, ezért nem txt a szótár fájlom, hanem excel.
A dictionary key eleme viszont vmiért ezeket nem veszi át.

Másik perverzebb ötletem az lenne, hogy még excelben helyettesíteni kell a vbcrln karaktereket valamilyen egyéb karakterre v láncra amit a mod végén visszahelyettesítenék (és ugye nincs a szövegben persze), de ugye ez plusz munka és nem vagyok túl szorgalmas ilyen fronton.
Szeretek tanulni a hibámból, mert minden bizonyára elvi hibám van.
Kérésre rendelkezésetekre tudom bocsátani az adatokat is, a kód így fest:

xlsx_dict = "U:\6_798\Translate\v01\pl.xlsx"
xlsx_trgt = "U:\6_798\Translate\v01\TIAProjectTexts_mod.xlsx"

Set fso = CreateObject( "Scripting.FileSystemObject" )
Set szotar = CreateObject("Scripting.Dictionary")

Set objExcel = CreateObject("Excel.Application")

if not fso.FileExists(xlsx_dict) then
MsgBox xlsx_dict + " nicht gefunden"
WScript.Quit()
end if

if not fso.FileExists(xlsx_trgt) then
MsgBox xlsx_trgt + " nicht gefunden"
WScript.Quit()
end if

objExcel.WorkBooks.Open xlsx_dict
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

'dict aufladen
for i=1 to 532
tmp1 = cStr(objSheet.Cells(i,1).Value)
tmp2 = cStr(objSheet.Cells(i,2).Value)

if not szotar.exists(tmp1) then
szotar.add tmp1, tmp2
else
'MsgBox "Problem mit key: " + tmp1
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.WorkBooks.Open xlsx_trgt
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Übersetzen
for i=2 to 24257
dtext = objSheet.Cells(i,5).Value
if szotar.exists(dtext) then
objSheet.Cells(i,6).Value = szotar(dtext)
else
'
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.Application.Quit

Set objSheet = nothing
set objExcel = nothing
Set szotar = nothing
Set fso = nothing

msgBox "Fertig"

Köszönöm az esetleges ötleteket!
Követem a fórumot és öröm olvasni a profi megoldásaitokat!

(#2870) Bazs87 válasza Bazs87 (#2869) üzenetére


Bazs87
(tag)

RITKÁN, de van hogy a lustaság nem kifizetődő

így már a tesztejim szerint működik:

xlsx_dict = "U:\6_798\Translate\v01\pl.xlsx"
xlsx_trgt = "U:\6_798\Translate\v01\TIAProjectTexts_mod.xlsx"

Set fso = CreateObject( "Scripting.FileSystemObject" )
Set wobu = CreateObject("Scripting.Dictionary")


Set objExcel = CreateObject("Excel.Application")

if not fso.FileExists(xlsx_dict) then
MsgBox xlsx_dict + " nicht gefunden"
WScript.Quit()
end if

if not fso.FileExists(xlsx_trgt) then
MsgBox xlsx_trgt + " nicht gefunden"
WScript.Quit()
end if

objExcel.WorkBooks.Open xlsx_dict
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

'dict aufladen
for i=1 to 532
tmp1 = cStr(objSheet.Cells(i,1).Value)
tmp2 = cStr(objSheet.Cells(i,2).Value)

tmp1 = Replace(tmp1,vbcrln,"</\>")
tmp2 = Replace(tmp2,vbcrln,"</\>")

if not wobu.exists(tmp1) then
wobu.add tmp1, tmp2
else
'MsgBox "Problem mit key: " + tmp1
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.WorkBooks.Open xlsx_trgt
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

'Übersetzen
for i=2 to 24257
dtext = objSheet.Cells(i,5).Value

dtext = Replace(dtext,vbcrln,"</\>")

if wobu.exists(dtext) then
tmp = Replace(wobu(dtext),"</\>",vbcrln)
objSheet.Cells(i,6).Value = tmp
else
'
end if
next

objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close


objExcel.Application.Quit

Set objSheet = nothing
set objExcel = nothing
Set wobu = nothing
Set fso = nothing

msgBox "Fertig"

(#2871) alfa20


alfa20
(senior tag)

Sziasztok!

Egy hálózaton van több gép is, ezek közül az egyik egy PI3 amin fut egy Webmin + Apache + MySQL, erre hogy tudok VB.NET-el fel csatlakozni?
MySQL Workbanch-el elérem az adatbázist SSH kapcsolattal
Pi3 IP: 192.168.0.13:22
Pi3 MySQL: 127.0.0.1::3306

Workbanch mind két jelszót kéri a Pi-ét és a adatbázisét is.

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

(#2872) martonx válasza alfa20 (#2871) üzenetére


martonx
(PH! addikt)

Nyilván az Pi3 IP-je fog neked kelleni, valami általad beállított porttal, amit előtte átengedsz a tűzfalon.
Azt hiszem a mysql-ben használatos user permissionjei is fontosak, már ha nem root-tal akarod használni.

Én kérek elnézést!

(#2873) alfa20 válasza martonx (#2872) üzenetére


alfa20
(senior tag)

Köszi, ezek mind be vannak állítva, másik gépről MySQL Workbanch-el elérem az adatbázist SSH kapcsolattal. Viszont azt nem tudom hogy tudnám ezt VB.NET-ben kivitelezni, eddig csak olyan csatlakozásokat találtam ahol egy IP:port címre kellett kapcsolódni, de nekem meg egyszer a Pi-re, majd onnan a MySQL-re.
Vagy nem tudom :(

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

(#2874) alfa20 válasza alfa20 (#2873) üzenetére


alfa20
(senior tag)

MySQL-ben kellett beállítani, hogy minden gép elérje most elérem a táblákat, jöhet a programozás :)

"Az agy olyan, mint az ejtőernyő: csak akkor működik, ha nyitott." (Thomas Dewar)

(#2875) alexy92 válasza martonx (#2867) üzenetére


alexy92
(fanatikus tag)

Ezzel a hozzáállással, sikerült megoldanom :O

(#2876) martonx válasza alexy92 (#2875) üzenetére


martonx
(PH! addikt)

És finomítottad, megírtad normálisra végül? :F

Én kérek elnézést!

(#2877) Bazs87


Bazs87
(tag)

Sziasztok!

LibreOffice Calc-ot szeretnék vbs-ből manipulálni. Minden fut gond és működik, egyetlen problémám a sheet kiválasztása. Próbáltam több különböző parancsot (index szerint, megnevezés szerint), de sajnos egyik sem működik. Először meg kell nyitnom a fájlt, aminek az activesheet-jét átveszi, emiatt viszont a második megnyitott fájl már írásvédett lesz és az általam generált bagatell módosításokat nem tudom átvenni. (le tudnám menteni más néven, vagyis meg tudnám kerülni ezt a probémát, de nem ez a cél, szeretnék egy elegáns megoldást találni erre)

Mivel a mahinálni kívánt fájl egy nagyon buta, de rendesen levédett fájl, ezért gondoltam arra is, hogy ott lehet a kutya elásva. A megoldásom viszont a teljesen sima új tesztcélra generált fájlt sem tudta az elvárásoknak megfelelően kezelni.
Remélem valaki találkozott már ezzel a problémával.
Köszönöm előre is!

class timecnt
dim st, et, ps, nwt, uswt, swt
end class

dim list(9)

' arrayclass deklaralas
for i=0 to 9
set list(i) = new timecnt
next

' adatok kiolvasasa

'----------------------------------------------------------------------------------------
'http://www.oooforum.de/viewtopic.php?t=44190

Set objServiceManager = WScript.CreateObject("com.sun.star.ServiceManager")
Set StarDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")

cURL = "file:///D:\BR\netzlaufwerk\NFO\vbs\libre_officemuster\test\test.ods"

set oDoc = StarDesktop.loadComponentFromURL( cURL, "_blank", 0, Array() )
set oSheet = oDoc.CurrentController.ActiveSheet

'egyeb nem mukodo megoldasok
'set oSheet = oDoc.getSheets().getByName( "Tabelle1" )
'set oSheets = oDoc.getSheets()
'set oSheet = oSheets.getByIndex(0)
'----------------------------------------------------------------------------------------

call librecalc_read

wknd = false

' szamitasok elvegzese
for i=0 to 9
with list(i)
sh = CutLeft ( .st, ":" )
sm = CutRight( .st, ":" )
eh = CutLeft ( .et, ":" )
em = CutRight( .et, ":" )

wtime = worktime_count(sh, sm, eh, em, .ps)
if not wknd then
if wtime<=8 then
.nwt = wtime
else
.nwt = 8
.uswt = wtime-8
.swt = 0
end if
else
.nwt = 0
.uswt = 0
.swt = wtime
end if
end with
next

' adatok kiirasa
call librecalc_write

erase list

'----------------------------------------------------------------------------------------
set oSheet = nothing
set oDoc = nothing
Set StarDesktop = nothing
Set objServiceManager = nothing
'----------------------------------------------------------------------------------------

MsgBox "process is done"



function worktime_count(starth, startm, endh, endm, pause)
'msgbox starth + " " + startm + "" + endh + " " + endm + " " + pause
worktime_count = cInt(endh) + cInt(endm) / 60 - cInt(starth) - cInt(startm)/60
if pause <> "" then worktime_count = worktime_count - cInt(pause) / 60
end function

function CutLeft(txt, sym)
if txt<>"" then
s_e = inStr( txt, sym )-1
CutLeft = left ( txt, s_e)
end if
end function

function CutRight(txt, sym)
if txt<>"" then
s_a = inStr(txt, sym)
CutRight = right(txt, len(txt) - s_a)
end if
end function

sub librecalc_read()
for i = 0 to 9
list(i).st = oSheet.getCellByPosition( 1, 15 + i ).String 'B16
list(i).et = oSheet.getCellByPosition( 2, 15 + i ).String 'C16
list(i).ps = oSheet.getCellByPosition( 6, 15 + i ).String 'G16
next
end sub

sub librecalc_write()
for i=0 to 9
with list(i)
if .nwt<>0 then
oSheet.getCellByPosition( 3, 15 + i ).Value = .nwt 'D16
end if
if .uswt<>0 then
oSheet.getCellByPosition( 4, 15 + i ).Value = .uswt 'E16
end if
if .swt<>0 then
oSheet.getCellByPosition( 5, 15 + i ).Value = .swt 'F16
end if
end with
next
end sub

(#2878) Vladek83


Vladek83
(tag)

Sziasztok!

Egy kicsit elakadtam, tudna valaki súgni?

Van egy TextBox amibe írok, akkor csak azokat az értékeket jeleníti meg, viszont hibára fut, mert közben egy PictureBox-ban kellene megjeleníteni külön a hozzá tartozó képet..
Együtt nem akar működni a kettő..

Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'Adatbázis1DataSet.Cikkek' table. You can move, or remove it, as needed.
Me.CikkekTableAdapter.Fill(Me.Adatbázis1DataSet.Cikkek)

End Sub

Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged

Dim search As String = "%" + TextBox1.Text + "%"

Me.CikkekTableAdapter.FillBySearchCikkek(Me.Adatbázis1DataSet.Cikkek, search, search)

End Sub

Private Sub DataGridView1_SelectionChanged(sender As Object, e As EventArgs) Handles DataGridView1.SelectionChanged

Dim imageName As String = DataGridView1.CurrentRow.Cells(3).Value.ToString()
Dim img As Image
img = Image.FromFile(Convert.ToString("D:\Images\") & imageName)
PictureBox1.Image = img

End Sub
End Class

(#2879) Bazs87 válasza Vladek83 (#2878) üzenetére


Bazs87
(tag)

a probléma megkerülése nem segít esetleg?

amíg az egyik fut deaktiválod a másik kódrészletet így keresztreteszelést létrehozva. Netán az textbox objektet "disable"-re állítod, ha van ilyen funkciója, miután pedig lefutott a kép manipuláció újra enabled. Tudom nem szép megoldás, de sajnos jobb ötletem nincs. VB6-ban dolgozol?

(#2880) Ispy válasza Vladek83 (#2878) üzenetére


Ispy
(PH! addikt)

Mi a hibaüzenet?

Egy ötlet: csinálsz egy timert, amit akkor kapcsolsz be, amikor a textbox lostfocus van, akkor a tick-ben feltöltöd a picturebox-ot és kikapcsolod a timert.

Három fajta ember van. Aki tud számolni, és aki nem.

(#2881) DasBoot


DasBoot
(tag)

Szép napot! Nagyon, nagyon kezdő vagyok a Visual Basic-ben, de egy konkrét feladatot szeretnék megoldani, ezen keresztül szeretnék ismerkedni vele. 6-os LOTTO-n szeretnék tippelni mégpedig úgy, hogy a mezőkön sohase ismétlődjenek a számok. A 45 számhoz 7 teljes mező kell + 1 a maradék 3 számnak, de nem ez a lényeg, mert újabb 45 is lehetne. Ezt MSExcel-ben el tudtam készíteni, nagyon jól működik, de Visual Basic-ben is szeretném. VB6-os programmal rendelkezem. Köszönöm a válaszokat. Üdv.: Joe

(#2882) Vladek83 válasza Bazs87 (#2879) üzenetére


Vladek83
(tag)

+ (#2880) Ispy köszönöm a javaslatokat! VB.net lenne. Most ismerkedem vele, eddig excelben próbálgattam írogatni..küzdök.. :)
úgy tűnik ezzel jó lehet:
Try

Dim search As String = "%" + TextBox1.Text + "%"

Me.TörzsTableAdapter.FillByKereses(Me.TörzsDataSet.Törzs, search, search, search)

Dim imageName As String = DataGridView1.CurrentRow.Cells(3).Value.ToString()
Dim img As Image
img = Image.FromFile(Convert.ToString("D:\Images\") & imageName)
PictureBox1.Image = img

Catch ex As Exception



End Try

Útvonal

Fórumok  »  Szoftverfejlesztés  »  Visual Basic
Copyright © 2000-2017 PROHARDVER Informatikai Kft.