|
so sieht der ganze code aus und irgendwie hakt es beim Auslesen...
Sub CommandButton1_Click()
Initial
'On Error Resume Next
poDialog.Execute
End Sub
Sub CommandButton2_Click()
'-------------check for playing around---------------
Dim byWert As Byte
byWert = MsgBox("If you want to create PO Number, push ok button!! Make sure that PO is completed!", vbOKCancel, "Confirmation")
If byWert = 2 Then
GoTo marke
End If
'-------------check for cost code and cost center---------------
If Range("H13").Value = "" Or Range("H14").Value = "" Then
MsgBox ("Please include Cost Code and Cost Center!")
GoTo marke
End If
'==================================COPY DATA========================================
Dim ponr, po_year
Dim orderdate, po_nr, cost_acc, cost_cen, qt_nr, supplier1, c_attention1, c_tel1, c_fax1, c_email1
Dim ship_to_customer, c_attention2, c_adress, o_name, o_tel, o_fax, o_email, counter, counter1
Dim payment_terms, delivery_terms, delivery_time, total_price, curr, Items(20, 20), freight, taxed, nontaxed, tax
Windows("PO_Tool_Optogan_Kopie.xlsm").Activate
Sheets("PO Master").Select
If Not Range("H7").Value = "" Then
MsgBox ("This number already exists!")
GoTo marke
End If
Sheets("PO Master").Select
'-------------terms---------------
orderdate = Range("H8").Value
po_nr = Range("H7").Value
cost_acc = Range("H13").Value
cost_cen = Range("H14").Value
qt_nr = Range("H9").Value
'-------------contact person Optogan---------------
o_name = Range("C41").Value
'o_tel = Range("C42").Value
'o_fax = Range("C43").Value
o_email = Range("C44").Value
'-------------supplier---------------
supplier1 = Range("C7").Value
c_adress = Range("C9").Value + ", " + Range("C10").Value + ", " + Range("C13").Value
c_attention1 = Range("C8").Value
c_tel1 = Range("C11").Value
c_fax1 = Range("C12").Value
'-------------conditions---------------
payment_terms = Range("H12").Value
delivery_terms = Range("H10").Value
delivery_time = Range("H11").Value
'-------------currency---------------
curr = Range("G17").Value
'curr = Right(curr, Len(curr) - 12)
'-------------total price---------------
total_price = Range("I251").Value
'-------------copy items of sheet 1---------------
Range("C18").Select
For o = 0 To 9
Items(o, 0) = Range("C18").Offset(o, 0).Value
Items(o, 1) = Range("D18").Offset(o, 0).Value
Items(o, 2) = Range("E18").Offset(o, 0).Value
Items(o, 3) = Range("F18").Offset(o, 0).Value
Items(o, 4) = Range("G18").Offset(o, 0).Value
Items(o, 5) = Range("H18").Offset(o, 0).Value
Items(o, 6) = Range("I18").Offset(o, 0).Value
For x = 0 To 9
Items(x, 0) = Range("C63").Offset(x, 0).Value
Items(x, 1) = Range("D63").Offset(x, 0).Value
Items(x, 2) = Range("E63").Offset(x, 0).Value
Items(x, 3) = Range("F63").Offset(x, 0).Value
Items(x, 4) = Range("G63").Offset(x, 0).Value
Items(x, 5) = Range("H63").Offset(x, 0).Value
Items(x, 6) = Range("I63").Offset(x, 0).Value
Next
Next
'-------------check if file is open---------------
If IsFileOpen("O:\PO\2_PO_MI\PO#.xls") Then
MsgBox "Somebody is using the PO# file. Please check in Folder O:\PO\O:\PO\2_PO_MI\PO#.xls or try later!"
GoTo marke
End If
If IsFileOpen("O:\PO\PO_Database.xlsx") Then
MsgBox "Somebody is using the PO_Database file. Please check in Folder O:\PO\PO_Database.xlsx or try later!"
GoTo marke
End If
Workbooks.Open Filename:="O:\PO\2_PO_MI\PO#.xls"
Sheets("2011").Select
Range("a10").Select
Dim currentmonth, nextponr
currentmonth = Right(Date, 7)
currentmonth = Right(currentmonth, 4) & "_" & Left(currentmonth, 2)
While Not currentmonth = Left(Selection.Value, 7) 'red
Selection.Offset(0, 1).Select
Wend
While Selection.Interior.Color = 255 'red
Selection.Offset(1, 0).Select
Wend
Selection.Interior.Color = 255
nextponr = Selection.Value
ActiveWorkbook.Close SaveChanges:=True
'=========================================CREATE PO NR========================================
'-------------check if file is open---------------
If IsFileOpen("O:\PO\PO_Database.xlsx") Then
MsgBox "Somebody is using the PO_Database file. Please check in Folder O:\PO\PO_Database.xlsx or try later!"
GoTo marke
End If
Workbooks.Open Filename:="O:\PO\PO_Database.xlsx"
Sheets("PO database").Select
Range("A7").Select
Dim pocheck, pobasic
While Not IsEmpty(Selection.Value)
Selection.Offset(1, 0).Select
Wend
ponr = Selection.Offset(-1, 0).Value
pocheck = Left(ponr, 7)
ponr = Right(ponr, Len(ponr) - 8)
ponr = ponr + 1
pobasic = Right(Date, 7)
pobasic = Right(pobasic, 4) & "_" & Left(pobasic, 2)
'-------------beginning of new month---------------
If Not pobasic = pocheck Then
ponr = 1
End If
ponr = pobasic & "_" & ponr
If Not ponr = nextponr Then
MsgBox ("there is discrepance between new and old po system!")
ponr = nextponr
End If
'=========================================STORE DATA FROM DASHBOARD========================================
Windows("PO_Tool_Optogan_Kopie.xlsm").Activate
Sheets("PO Master").Select
Range("H7").Value = ponr
Windows("PO_Database.xlsx").Activate
Sheets("po database").Select
Selection.Value = ponr
'-------------1_order date---------------
Selection.Offset(0, 1).Value = orderdate
'-------------2_quotation number---------------
Selection.Offset(0, 2).Value = qt_nr
'-------------3_cost code---------------
Selection.Offset(0, 3).Value = cost_acc
'-------------4_cost center---------------
Selection.Offset(0, 4).Value = cost_cen
'-------------5_supplier---------------
Selection.Offset(0, 5).Value = supplier1
'-------------6_customer adress---------------
Selection.Offset(0, 6).Value = c_adress
'-------------7_customer attention---------------
Selection.Offset(0, 7).Value = c_attention1
'-------------8_customer tel---------------
Selection.Offset(0, 8).Value = c_tel1
'-------------9_customer fax---------------
Selection.Offset(0, 9).Value = c_fax1
'-------------10_OG name---------------
Selection.Offset(0, 10).Value = o_name
'-------------11_OG email---------------
Selection.Offset(0, 11).Value = o_email
'-------------12_payment terms---------------
Selection.Offset(0, 12).Value = payment_terms
'-------------13_delivery terms---------------
Selection.Offset(0, 13).Value = delivery_terms
'-------------14_delivery time---------------
Selection.Offset(0, 14).Value = delivery_time
'-------------15_total price---------------
Selection.Offset(0, 15).Value = total_price
'-------------16_currency---------------
Selection.Offset(0, 16).Value = curr
'=========================================STORE PRODUCTS OF DASHBOARD========================================
'-------------1_sheet---------------
counter = 0
For o = 0 To 9
For i = 0 To 6
counter = counter + 1
Selection.Offset(0, 17 + counter).Value = Items(o, i)
Next
For x = 0 To 9
For u = 0 To 6
counter = counter + 1
Selection.Offset(0, 87 + counter).Value = Items(x, u)
Next
Next
Next
'-------------save and close---------------
ActiveWorkbook.Close SaveChanges:=True
Windows("PO_Tool_Optogan_Kopie.xlsm").Activate
Sheets("po master").Select
marke:
End Sub
Sub DruckenSpeichern()
Dim poname
Sheets("PO Master").Select
poname = Range("L3").Value & "_" & Range("C35").Value
If Range("L3").Value = "" Then
MsgBox ("Please, create po number!")
GoTo marke
End If
'-------------save file---------------
ActiveWorkbook.SaveAs Filename:= _
"O:\PO\3_POP\" + poname + ".xls", FileFormat:=xlOpenXMLWorkbook _
, CreateBackup:=False
ActiveWorkbook.Close
marke:
End Sub
Public Function IsFileOpen(ByRef Path As String) As Boolean
Dim FileNr As Integer
Dim ErrorNr As Long
'Datei testweise öffnen:
On Error Resume Next
FileNr = FreeFile
Open Path For Input Lock Write As #FileNr
ErrorNr = Err.Number
Close #FileNr
On Error GoTo 0
'Ggf. Fehler verarbeiten:
Select Case ErrorNr
Case 0 'kein Fehler:
'NOP
Case 70 'Permission denied':
IsFileOpen = True
Case Else 'sonstiger Fehler:
Err.Raise ErrorNr
End Select
End Function
|