|
Hallo VBA Experten,
um Fehler bei der Eingabe in ein Dokument zu verhindern, habe ich einige Zellen geschützt mit der Folge, dass das Makro nicht mehr funktionierte.
Dieses Problem konnte ich zunächst ausräumen, indem ich im Makro den Schutz zunächst deaktiviert und später wieder aktiviert habe.
Nun funktioniert aber bedauerlicherweise der CSV Export nicht mehr und ich komme mit meinem Unwissen einfach nicht mehr weiter.
Über jede Hilfe würde ich mich freuen.
Grüße
Okiem
Option Explicit
Private Const mainAccIDRow = 9
Private Const mainAccIDCol = "D"
Private Const mainAccNameCol = "G"
Private Const mainAccClassCol = "H"
Private Const mainOrderRefRow = 10
Private Const mainOrderRefCol = "D"
Private Const mainTotalRow = 11
Private Const mainTotalCol = "D"
Private Const mainFirstItemRow = 16
Private Const mainItemCol = "C"
Private Const mainQtyCol = "D"
Private Const mainDescCol = "G"
Private Const mainDiscCol = "H"
Private Const mainLineRefCol = "I"
Private Const mainStatusCol = "J"
Private Sub validateQty(ByVal targetRow As Long)
If (mainSheet.Cells(targetRow, mainQtyCol) = 0) Then
If (IsEmpty(mainSheet.Cells(targetRow, mainItemCol))) Then
mainSheet.Cells(targetRow, mainQtyCol).Interior.ColorIndex = 0
Else
mainSheet.Cells(targetRow, mainQtyCol).Interior.ColorIndex = 3
End If
Else
mainSheet.Cells(targetRow, mainQtyCol).Interior.ColorIndex = 35
End If
End Sub
Private Sub createExport(ByVal fileName As String)
Dim rowLoop As Long
Dim nextItem As String
Open fileName For Output As #1
MsgBox mainSheet.Cells(16, "J").Font.ColorIndex
exportHeader Trim(mainSheet.Cells(mainAccIDRow, mainAccIDCol)), Trim(mainSheet.Cells(mainOrderRefRow, mainOrderRefCol))
rowLoop = mainFirstItemRow
Do
nextItem = Trim(mainSheet.Cells(rowLoop, mainItemCol))
If (nextItem <> "") And (mainSheet.Cells(rowLoop, mainQtyCol) > 0) And (UCase(Trim(mainSheet.Cells(rowLoop, mainDiscCol))) = "N") Then
exportLine Trim(mainSheet.Cells(rowLoop, mainItemCol)), mainSheet.Cells(rowLoop, mainQtyCol), _
Trim(mainSheet.Cells(rowLoop, mainLineRefCol))
mainSheet.Cells(rowLoop, mainStatusCol).Font.ColorIndex = 10
mainSheet.Cells(rowLoop, mainStatusCol) = "P"
ElseIf (nextItem <> "") Then
mainSheet.Cells(rowLoop, mainStatusCol).Font.ColorIndex = 3
mainSheet.Cells(rowLoop, mainStatusCol) = "O"
End If
rowLoop = rowLoop + 1
Loop While (nextItem <> "")
Close #1
End Sub
Public Sub createCSVButton_Click2()
Dim fileName As String
If (mainSheet.Cells(mainTotalRow, mainTotalCol) > 0) Then
If (Len(Trim(mainSheet.Cells(mainAccIDRow, mainAccIDCol))) >= 5) Then
fileName = Trim(mainSheet.Cells(mainAccIDRow, mainAccIDCol)) & "-" & Format(Now(), "YYYYMMDD-HHMMSS") & ".csv"
fileName = Application.GetSaveAsFilename(fileName, "CSV File, *.csv", 1, "Select Destination")
If (fileName <> "False") Then createExport (fileName)
Else
MsgBox "Missing/Invalid Account ID", vbExclamation, "Order Export Error"
End If
Else
MsgBox "Cannot create order: Quantity = 0", vbExclamation, "Order Export Error"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Range("D16:D25,F16:F25").Select
Range("F25").Activate
Selection.Locked = False
Selection.FormulaHidden = False
Dim importRow As Long
Dim rowNum As Long
Dim targetValue As String
Application.EnableEvents = False
If (Target.Row = mainAccIDRow) And (Target.Column = 4) Then
targetValue = Trim(mainSheet.Cells(mainAccIDRow, mainAccIDCol))
mainSheet.Cells(9, "D").Interior.ColorIndex = 0
If (targetValue <> "") Then
rowNum = findAccountName(targetValue)
If (rowNum > 0) Then
mainSheet.Cells(mainAccIDRow, mainAccNameCol) = custSheet.Cells(rowNum, "B")
mainSheet.Cells(mainAccIDRow, mainAccClassCol) = custSheet.Cells(rowNum, "C")
Else
mainSheet.Cells(mainAccIDRow, mainAccIDCol).Interior.ColorIndex = 3
mainSheet.Cells(mainAccIDRow, mainAccNameCol) = "ACCOUNT NOT FOUND"
mainSheet.Cells(mainAccIDRow, mainAccClassCol) = ""
End If
Else
mainSheet.Cells(mainAccIDRow, mainAccNameCol) = ""
mainSheet.Cells(mainAccIDRow, mainAccClassCol) = ""
End If
Else
For importRow = Target.Row To (Target.Row + (Target.Count - 1))
If (Target.Row >= mainFirstItemRow) And (Target.Column = 3) Then
targetValue = UCase(Trim(mainSheet.Cells(importRow, mainItemCol)))
If (Trim(targetValue) <> "") Then
rowNum = findItem(targetValue)
mainSheet.Cells(importRow, mainItemCol).Interior.ColorIndex = 19
If (rowNum > 0) Then
mainSheet.Cells(importRow, mainDescCol) = itemSheet.Cells(rowNum, "B")
mainSheet.Cells(importRow, mainDiscCol) = itemSheet.Cells(rowNum, "C")
If (mainSheet.Cells(importRow, mainDiscCol) = "Y") Then mainSheet.Cells(importRow, mainItemCol).Interior.ColorIndex = 3
validateQty (importRow)
Else
mainSheet.Cells(importRow, mainItemCol).Interior.ColorIndex = 3
mainSheet.Cells(importRow, mainDescCol) = "ITEM NOT FOUND"
mainSheet.Cells(importRow, mainDiscCol) = ""
End If
mainSheet.Cells(importRow, mainItemCol) = targetValue
Else
mainSheet.Rows(importRow).Delete
End If
ElseIf (Target.Row >= mainFirstItemRow) And (Target.Column = 4) Then
validateQty (importRow)
End If
Next importRow
End If
Application.EnableEvents = True
Range("D16:D25,F16:F25").Select
Range("F16").Activate
Selection.Locked = True
Selection.FormulaHidden = False
ActiveWindow.SmallScroll Down:=-4
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
|