Public Static Sub CncOut()
On Error GoTo Fehler
If Sheets("CNC Programm").Range("V8").Value = "" Then
MsgBox "Bitte geben Sie eine gültige Auftragsbezeichnung ein.", vbInformation
Exit Sub
End If
Dim Zeile As Long
Dim DateiNameInput As String
Dim DateiNameOutput As String
Dim Laenge As Double
Dim Breite As Double
Dim Dicke As Double
Dim Bandseite As Double
Dim Schwelle As Double
Dim Rahmenfasen As Double
Dim Rokustrip As Double
Dim Kappen As Double
Dim Rahmenbreite_Bandseite As Double
Dim Rahmenbreite_Schliessblechseite As Double
Dim Rahmenbreite_oben As Double
Dim Schliessblechposition As Double
Dim Falztiefe As Double
Dim Falzhöhe As Double
Dim Schliesblechtyp As Double
Dim Drückerhöhe As Double
Dim Türluftoben As Double
Dim Bodenluft As Double
Dim Türblatlänge As Double
Dim Bandtyp As Double
Dim Bandanzahl As Double
Dim Bandbezugslinie1 As Double
Dim Bandbezugslinie2 As Double
Dim Bandbezugslinie3 As Double
Dim Mittelanschlagsdurchmesser As Double
Dim Türtyp As Double
Dim Planettyp As Double
Dim Türe_fasen As Double
Dim Dichtungsnut As Double
Dim Ausschnitttyp As Double
Dim Rosettenbohrung As Double
Dim Dornmass As Double
Dim Abstand_Oberflächenfalle As Double
Dim BereichsGrenzeStart As String
Dim BereichsGrenzeEnde As String
BereichsGrenzeStart = "[001"
BereichsGrenzeEnde = "]1"
Dim LaengePos As String
Dim BreitePos As String
Dim DickePos As String
Dim BandseitePos As String
Dim SchwellePos As String
Dim RahmenfasenPos As String
Dim RokustripPos As String
Dim KappenPos As String
Dim Rahmenbreite_BandseitePos As String
Dim Rahmenbreite_SchliessblechseitePos As String
Dim Rahmenbreite_obenPos As String
Dim SchliessblechpositionPos As String
Dim FalztiefePos As String
Dim FalzhöhePos As String
Dim SchliesblechtypPos As String
Dim DrückerhöhePos As String
Dim TürluftobenPos As String
Dim BodenluftPos As String
Dim TürblatlängePos As String
Dim BandtypPos As String
Dim BandanzahlPos As String
Dim BandbezugslinieaPos As String
Dim BandbezugsliniebPos As String
Dim BandbezugsliniecPos As String
Dim MittelanschlagsdurchmesserPos As String
Dim TürtypPos As String
Dim PlanettypPos As String
Dim Türe_fasenPos As String
Dim DichtungsnutPos As String
Dim AusschnitttypPos As String
Dim RosettenbohrungPos As String
Dim DornmassPos As String
Dim Abstand_OberflächenfallePos As String
LaengePos = "l="
BreitePos = "b="
DickePos = "d="
BandseitePos = "bs="
SchwellePos = "schwelle"
RahmenfasenPos = "rahfas"
RokustripPos = "roku"
KappenPos = "kappen"
Rahmenbreite_BandseitePos = "bb"
Rahmenbreite_SchliessblechseitePos = "bsc"
Rahmenbreite_obenPos = "rbqo"
SchliessblechpositionPos = "fath"
FalztiefePos = "fat"
FalzhöhePos = "fah"
SchliesblechtypPos = "sctyp"
DrückerhöhePos = "scdh"
TürluftobenPos = "luft"
BodenluftPos = "boluft"
TürblatlängePos = "tbllaeng"
BandtypPos = "batyp"
BandanzahlPos = "baz"
BandbezugslinieaPos = "bh1"
BandbezugsliniebPos = "bh2"
BandbezugsliniecPos = "bh3"
MittelanschlagsdurchmesserPos = "anschldm"
TürtypPos = "tuertyp"
PlanettypPos = "pttyp"
Türe_fasenPos = "tuerfas"
DichtungsnutPos = "dinut"
AusschnitttypPos = "auschtyp"
RosettenbohrungPos = "rosbohr"
DornmassPos = "scdm"
Abstand_OberflächenfallePos = "scfa"
Dim DirInput As String
DirInput = Sheets("CNC Programm").Range("U4").Value
Dim DirOutput As String
DirOutput = Sheets("CNC Programm").Range("U6").Value
pos = Sheets("CNC Programm").Range("V9").Value
Dim FSO
Set FSO = CreateObject("Scripting.Filesystemobject")
If Not FSO.FolderExists(DirOutput) Then
CreateFullPath DirOutput
End If
For Zeile = 16 To 50
If Not Sheets("CNC Programm").Range("V" & Zeile) = "" And Not Sheets("CNC Programm").Range("V" & Zeile) = "" Then
With Sheets("CNC Programm")
DateiNameInput = DirInput & "\" & .Range("V" & Zeile).Value
DateiNameOutput = DirOutput & "\" & "Pos" & "_" & pos & "_" & .Range("U" & Zeile).Value & ".mpr"
Laenge = .Range("W" & Zeile).Value
Breite = .Range("X" & Zeile).Value
Dicke = .Range("Y" & Zeile).Value
Bandseite = .Range("AC" & Zeile).Value
Schwelle = .Range("Z" & Zeile).Value
Rahmenfasen = .Range("AA" & Zeile).Value
Rokustrip = .Range("AB" & Zeile).Value
Kappen = .Range("AD" & Zeile).Value
Rahmenbreite_Bandseite = .Range("AE" & Zeile).Value
Rahmenbreite_Schliessblechseite = .Range("AF" & Zeile).Value
Rahmenbreite_oben = .Range("AG" & Zeile).Value
Schliessblechposition = .Range("AH" & Zeile).Value
Falztiefe = .Range("AI" & Zeile).Value
Falzhöhe = .Range("AJ" & Zeile).Value
Schliesblechtyp = .Range("AK" & Zeile).Value
Drückerhöhe = .Range("AL" & Zeile).Value
Türluftoben = .Range("AM" & Zeile).Value
Bodenluft = .Range("AN" & Zeile).Value
Türblatlänge = .Range("AO" & Zeile).Value
Bandtyp = .Range("AP" & Zeile).Value
Bandanzahl = .Range("AQ" & Zeile).Value
Bandbezugsliniea = .Range("AR" & Zeile).Value
Bandbezugslinieb = .Range("AS" & Zeile).Value
Bandbezugsliniec = .Range("AT" & Zeile).Value
Mittelanschlagsdurchmesser = .Range("AU" & Zeile).Value
Türtyp = .Range("AV" & Zeile).Value
Planettyp = .Range("AW" & Zeile).Value
Türe_fasen = .Range("AX" & Zeile).Value
Dichtungsnut = .Range("AY" & Zeile).Value
Ausschnitttyp = .Range("AZ" & Zeile).Value
Rosettenbohrung = .Range("BA" & Zeile).Value
Dornmass = .Range("BB" & Zeile).Value
Abstand_Oberflächenfalle = .Range("BC" & Zeile).Value
End With
Dim readFile As Integer
Dim writeFile As Integer
Dim AktTxt As String
readFile = FreeFile
Open DateiNameInput For Input As #readFile
writeFile = FreeFile
Open DateiNameOutput For Output As #writeFile
Do Until EOF(readFile)
Line Input #readFile, AktTxt
If InStr(AktTxt, BereichsGrenzeStart) <> 0 Then
Print #writeFile, AktTxt
Do Until AktTxt = ""
Line Input #readFile, AktTxt
If InStr(AktTxt, LaengePos) <> 0 Then
Print #writeFile, LaengePos & Chr(34) & Replace(Laenge, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BreitePos) <> 0 Then
Print #writeFile, BreitePos & Chr(34) & Replace(Breite, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, DickePos) <> 0 Then
Print #writeFile, DickePos & Chr(34) & Replace(Dicke, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BandseitePos) <> 0 Then
Print #writeFile, BandseitePos & Chr(34) & Replace(Bandseite, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, SchwellePos) <> 0 Then
Print #writeFile, SchwellePos & Chr(34) & Replace(Schwelle, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, RahmenfasenPos) <> 0 Then
Print #writeFile, RahmenfasenPos & Chr(34) & Replace(Rahmenfasen, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, RokustripPos) <> 0 Then
Print #writeFile, RokustripPos & Chr(34) & Replace(Rokustrip, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, KappenPos) <> 0 Then
Print #writeFile, KappenPos & Chr(34) & Replace(Kappen, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, Rahmenbreite_BandseitePos) <> 0 Then
Print #writeFile, Rahmenbreite_BandseitePos & Chr(34) & Replace(Rahmenbreite_Bandseite, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, Rahmenbreite_SchliessblechseitePos) <> 0 Then
Print #writeFile, Rahmenbreite_SchliessblechseitePos & Chr(34) & Replace(Rahmenbreite_Schliessblechseite, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, Rahmenbreite_obenPos) <> 0 Then
Print #writeFile, Rahmenbreite_obenPos & Chr(34) & Replace(Rahmenbreite_oben, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, SchliessblechpositionPos) <> 0 Then
Print #writeFile, SchliessblechpositionPos & Chr(34) & Replace(Schliessblechposition, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, FalztiefePos) <> 0 Then
Print #writeFile, FalztiefePos & Chr(34) & Replace(Falztiefe, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, FalzhöhePos) <> 0 Then
Print #writeFile, FalzhöhePos & Chr(34) & Replace(Falzhöhe, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, SchliesblechtypPos) <> 0 Then
Print #writeFile, SchliesblechtypPos & Chr(34) & Replace(Schliesblechtyp, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, DrückerhöhePos) <> 0 Then
Print #writeFile, DrückerhöhePos & Chr(34) & Replace(Drückerhöhe, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, TürluftobenPos) <> 0 Then
Print #writeFile, TürluftobenPos & Chr(34) & Replace(Türluftoben, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BodenluftPos) <> 0 Then
Print #writeFile, BodenluftPos & Chr(34) & Replace(Bodenluft, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, TürblatlängePos) <> 0 Then
Print #writeFile, TürblatlängePos & Chr(34) & Replace(Türblatlänge, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BandtypPos) <> 0 Then
Print #writeFile, BandtypPos & Chr(34) & Replace(Bandtyp, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BandanzahlPos) <> 0 Then
Print #writeFile, BandanzahlPos & Chr(34) & Replace(Bandanzahl, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BandbezugslinieaPos) <> 0 Then
Print #writeFile, BandbezugslinieaPos & Chr(34) & Replace(Bandbezugsliniea, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BandbezugsliniebPos) <> 0 Then
Print #writeFile, BandbezugsliniebPos & Chr(34) & Replace(Bandbezugslinieb, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, BandbezugsliniecPos) <> 0 Then
Print #writeFile, BandbezugsliniecPos & Chr(34) & Replace(Bandbezugsliniec, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, MittelanschlagsdurchmesserPos) <> 0 Then
Print #writeFile, MittelanschlagsdurchmesserPos & Chr(34) & Replace(Mittelanschlagsdurchmesser, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, TürtypPos) <> 0 Then
Print #writeFile, TürtypPos & Chr(34) & Replace(Türtyp, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, PlanettypPos) <> 0 Then
Print #writeFile, PlanettypPos & Chr(34) & Replace(Planettyp, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, Türe_fasenPos) <> 0 Then
Print #writeFile, Türe_fasenPos & Chr(34) & Replace(Türe_fasen, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, DichtungsnutPos) <> 0 Then
Print #writeFile, DichtungsnutPos & Chr(34) & Replace(Dichtungsnut, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, AusschnitttypPos) <> 0 Then
Print #writeFile, AusschnitttypPos & Chr(34) & Replace(Ausschnitttyp, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, RosettenbohrungPos) <> 0 Then
Print #writeFile, RosettenbohrungPos & Chr(34) & Replace(Rosettenbohrung, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, DornmassPos) <> 0 Then
Print #writeFile, DornmassPos & Chr(34) & Replace(Dornmass, ",", ".") & Chr(34)
ElseIf InStr(AktTxt, Abstand_OberflächenfallePos) <> 0 Then
Print #writeFile, Abstand_OberflächenfallePos & Chr(34) & Replace(Abstand_Oberflächenfalle, ",", ".") & Chr(34)
Else
Print #writeFile, AktTxt
End If
Loop
Else
Print #writeFile, AktTxt
End If
Loop
Close #readFile
Close #writeFile
End If
Next
MsgBox "Ich habe fertig...", vbInformation
Exit Sub
Fehler:
MsgBox Err.Number & ": " & Err.Description, vbCritical
End Sub
Public Sub CreateFullPath(ByVal Path As String)
Dim FSO As Object
Dim ParentPath As String
Set FSO = CreateObject("Scripting.FileSystemObject")
ParentPath = FSO.GetParentFolderName(Path)
If Not FSO.FolderExists(ParentPath) Then CreateFullPath ParentPath
If Not FSO.FolderExists(Path) Then FSO.CreateFolder Path
End Sub