Anfänger: Script zur Transformation von Fräskräften?

[Rednaxela]

Ja es ist Gruppenname1

Gerade ist mir noch was in den Weg gekommen:

Code:

oExcel.ActiveWorkbook.SaveAs(AutoActPath & "\Auswertung\" & Gruppenname & ".xls")

Kannst Du mir sagen, wieso das so nicht funktioniert? Es kommt die Meldung:

Zitat:111 19:08:04 Fehler:
Fehler in <Main4.VBS> (Zeile: 464, Spalte: 50):
Auf die Datei konnte nicht zugegriffen werden. Versuchen Sie die folgenden Lösungsvorschläge:
• Überprüfen Sie, ob der angegebene Ordner vorhanden ist.
• Stellen Sie sicher, dass der Ordner, in dem sich die Datei befindet, nicht schreibgeschützt ist.
• Vergewissern Sie sich, dass der Dateiname keines der folgenden Zeichen enthält: < > ? [ ] : | oder *
• Der Dateiname darf nicht länger als 218 Zeichen sein.

--> Ordner ist vorhanden!
--> Kein Schreibschutz!
--> Keines der Zeichen entahlten!
--> Name ist nicht zu lang!

Wenn ich es wie folgt mache, geht es:

Code:

oExcel.ActiveWorkbook.SaveAs("C:\Dokumente und Einstellungen\Administrator\Desktop\Script Alex Selfmade\Auswertung\" & Gruppenname & ".xls")

Woran liegt das, was mache ich falsch?

Gruß,
Alex

PS: Danke für den "Namesplit"-Code! Werd ich nachher testen!

[Bruno]

Hi Alex,
hast Du Dir das Ergebnis des Ausdrucks mal ganau angesehen?
Z.B. mit msgbox(AutoActPath & "\Auswertung\" & Gruppenname & ".xls") oder noch besser über den Debugger als Überwachungsausdruck?
Gruß
Bruno

[Rednaxela]

Hi Bruno!
Hab den Fehler:

Das ist eine Fehlermeldung aus dem Excel nicht aus DIAdem. Das Problem sind doppelte "\\" im Pfad. Da ist Excel "empfindlicher" als DIAdem. Die Pfade in DIAdem wie AutoActpath enden alle mit "\". Dazu kommt das "\" in "\Auswertung\".

Die Zeile funktioniert also:

Code:

oExcel.ActiveWorkbook.SaveAs(AutoActPath & "Auswertung\" & Gruppenname & ".xls")

Gruß,
Alex

[Rednaxela]

Namesplit-Code funktioniert übrigens, ist super so!

Bin gerade auf noch was gestoßen... was für ein Wunder... sorry, dass ich so anstrengend bin...

1)
Über folgenden Zeilen in meinem Script füge ich Kurven in ein 2D-Diagramm ein:

Code:

' add channels
Call AddChannels(oTopArea, "", "[1]/Fv", "Black")
Call AddChannels(oTopArea, "", "[1]/Fvn", "Blue")
Call AddChannels(oTopArea, "", "[1]/Fz", "Green")
Call AddChannels(oTopArea, "", "[1]/Result XY", "Red")
'-------------------------------------------------------------------------------
' add channel pair
'-------------------------------------------------------------------------------
Sub AddChannels(oArea, iCh1, iCh2, sColor)
Dim oCurrDispObj
  ' create display object
  Set oCurrDispObj = oArea.DisplayObj

  ' add two new channel pairs given by the parameters iCh1 and iCh2
  Call oCurrDispObj.Curves.Add(iCh1, iCh2)

  ' set color
  oCurrDispObj.Curves(1).color = sColor
End Sub

Irgendwie macht DIAdem die Farben trotzdem so, wie es sie will!? Ich seh den Fehler nicht!

2)
Beim Excel-Export übertrage ich bspw. den Kanal "[1]/CopyYFv" in eine Spalte! Kann ich den max und min Wert dieser Spalte markieren, z.B. mit rot und blau? Mein Excel-Export-Code:

Code:

Call DataMatrixToExcel()

'-------------------------------------------------------------------------------
' DataMatrixToExcel
' Diese Prozedur uebertraegt die Daten aus der Datenmatrix an Excel.
' Dazu wird Excel als Apllikation gestartet und die Daten werden über die
' Active-X Schnittstelle von Excel übertragen
'-------------------------------------------------------------------------------
Sub DataMatrixToExcel

Dim oExcel,oWorkbookT,oSheetT,iChannelT,lFirstDataRowT,lChnCountT,lLengthT,lProzent,​ iIndex1, iIndex2

'-------------------------------------------------
' Excel als Applikation starten :
'-------------------------------------------------
Set oExcel = CreateObject("Excel.Application")
' Erste Zeile mit Daten :
lFirstDataRowT = 6

'-------------------------------------------------
' Neues Woorkbook und Sheet in Excel anlegen :
'-------------------------------------------------
Set oWorkbookT = oExcel.Workbooks.Add()
'Sheet in Excel anlegen
Set oSheetT = oWorkbookT.Sheets.Add


' Kanaele zaehlen
lChnCountT = 0
For iChannelT = 1 To ChnNoMax
if ( 0 >= Len(ChnName(iChannelT)) ) Then Exit For
lChnCountT = lChnCountT + 1
Next

' Namen des Tabellenblatts setzen in das die DIAdem-Daten eingetragen werden
oSheetT.Name = "TV" & TVnr & "_fz" & fz

'-------------------------------------------------
' Informationen aus dem Kanalheader uebertragen :
'-------------------------------------------------
For iChannelT = 1 To lChnCountT
oSheetT.Cells(1, iChannelT) = ChnName(iChannelT)
oSheetT.Cells(2, iChannelT) = ChnComment(iChannelT)
oSheetT.Cells(3, iChannelT) = ChnDim(iChannelT)
oSheetT.Cells(4, iChannelT) = ChnLength(iChannelT)
' Noch was fuers Auge ....
oSheetT.Cells(5, iChannelT).Interior.ColorIndex = 48
oSheetT.Columns(iChannelT).AutoFit
Next

'-------------------------------------------------
' Kanaldaten übertragen
'-------------------------------------------------
For iChannelT = 5 To lChnCountT
Call LoopInit()
Call MsgLineDisp("Übertragung des Kanals '"&ChnName(iChannelT)&"' ("&CStr(ChnLength(iChannelT))&" Werte)")

' ----- ist ein NV-Wert im Kanal ?
if ucase(ChnNovKey(iChannelT)) = "YES" then
   For iIndex1 = 1 To ChnLength(iChannelT)
   oSheetT.Cells(lFirstDataRowT+iIndex1-1, iChannelT) = GetValue(iIndex1,iChannelT)
   lProzent = (iIndex1*100)/ChnLength(iChannelT)
   If ( 0 = (lProzent Mod 5 ) ) Then Call LoopInc(lProzent)
    Next
else
   For iIndex2 = 1 To ChnLength(iChannelT)
   oSheetT.Cells(lFirstDataRowT+iIndex2-1, iChannelT) = GetValueX(iIndex2,iChannelT)
   lProzent = (iIndex2*100)/ChnLength(iChannelT)
   If ( 0 = (lProzent Mod 5 ) ) Then Call LoopInc(lProzent)
    Next
end if

Call LoopDeInit()
Next

' Excel anzeigen
oExcel.Visible = true
If MsgBox("Excel schließen?", vbYesNo Or vbQuestion, "Bestätigen") = vbYes Then

  ' Save actual Excel-Workbook
  oExcel.ActiveWorkbook.SaveAs(AutoActPath & "Auswertung\" & Gruppenname & ".xls")  
  ' In VBS, Excel must be closed explicitly.
  oExcel.Quit

Else

  ' Save actual Excel-Workbook
  oExcel.ActiveWorkbook.SaveAs(AutoActPath & "Auswertung\" & Gruppenname & ".xls")
End If

' Set object references to 'Nothing'.
Set oSheetT = Nothing
Set oExcel = Nothing

End Sub

' ----- holt Werte und prüft nicht auf NV
function GetValueX(iIdxT, iChnT)

GetValueX = CHD(iIdxT,iChnT)

end function

' ----- holt Werte und prüft auf NV
function GetValue(iIdxT, iChnT)

dim vVal
vVal = CHD(iIdxT,iChnT)
if IsNull(vVal) then
   GetValue = "Novalue"
else
   GetValue = vVal
end if    

end function

Gruß

[Rednaxela]

UPDATE

Zu 1)
Wenn man den Code wie folgt umschreibt, funktioniert die Sache mit der Kurvenfarbe:

Code:

Sub AddChannels(oArea, iCh1, iCh2, sColor)
Dim oCurrDispObj
  ' create display object
  Set oCurrDispObj = oArea.DisplayObj

  ' add two new channel pairs given by the parameters iCh1 and iCh2
  Dim oNewCurve
  set oNewCurve = oCurrDispObj.Curves.Add(iCh1, iCh2)

  ' set color
  oNewCurve.color = sColor
End Sub

Somit wäre auch 1) geklärt

Bleibt noch 2) aus Beitrag #34 ...?

Grüße,
Alex

[Bruno]

Hi Alex,
wie Du die Farbe einer Excel Zelle änderst hast Du doch schon herausgefunden!?
Jetzt musst Du doch nur noch Deine Daten mit den Min- / Maxwerten (z.B. CMax oder das Kanalproperty "maximum") vergleichen und entsprechend die Farbe setzen...
Gruß
Bruno

[Rednaxela]

Hmm, ja! Wie ich die Farbe setze, weiß ich:

Code:

oSheetT.Cells(5, iChannelT).Interior.ColorIndex = 48

Wobei gilt:
Farbcode 48 = grau
Farbcode 3 = rot
Farbcode 5 = blau

Aber wie ich jetzt über OLE meine in Excel übertragene Daten mit den Min- / Maxwerten vergleiche und bei der entsprechenden Zelle dann die Farbe setze, ist mir noch ein Rätsel!

[Bruno]

Hi Alex,
mach den Vergleich doch direkt bei der Übertragung. In der Schleife, in der Du die Daten nach Excel sendest, kannst Du doch eine Überprüfung auf die in DIAdem bekannten Minima / Maxima machen und dann sofort die Farbe setzten...
Gruß
Bruno

[Rednaxela]

Hi Bruno,
hab folgenden Code gefunden und etwas rumprobiert, aber irgendwie will das nicht so richtig klappen!?

Code:

Sub MiniMaxi()
Dim MIN
Dim MAX
Dim Cell
Dim i             'Zähler für die Zeile
Dim k             'Zähler für die Spalte

Range("A1").Select
i = 0
k = 0

Do While ActiveCell.Offset(i, k).Value <> ""
If MAX < ActiveCell.Offset(i, k).Value Then MAX = ActiveCell.Offset(i, k).Value
If MIN > ActiveCell.Offset(i, k).Value Then MIN = ActiveCell.Offset(i, k).Value
i = i + 1
Loop

i = 0
Do While ActiveCell.Offset(i, k).Value <> ""
If ActiveCell.Offset(i, k).Value = MAX Then ActiveCell.Offset(i, k).Interior.ColorIndex = 3
If ActiveCell.Offset(i, k).Value = MIN Then ActiveCell.Offset(i, k).Interior.ColorIndex = 5
i = i + 1
Loop
k = k + 1
i = 0
End Sub

Gruss

[Bruno]

Hi Alex,
was klappt denn nicht? (Ich habe ja hier nichts zum austesten...)
Ich denke auch, dass mein Ansatz der Bessere (Schnellere) ist...
Gruß
Bruno