Hi
also erstmal folgendes: Ich hab jetzt ein ganz primitives Wait ( an den 2 Stellen eingebaut um zu testen ob es wirklich daran liegt, da ansonsten die ganze herumprobiererei mit der API sinnlos wäre, wenn ich die gar nicht brauch.
Ergebnis dieses Tests (es geht immer nur um den einen PC meines Kollegen): Es hat jetzt zwar öfters aber nicht immer geklappt mit einem Wait von 1 oder 2 Sekunden. Also ich weiß jetzt nicht wirklich woran das Problem liegt. Noch dazu ist das Problem gerade eben zum ersten Mal auch noch bei einem anderen Kollegen aufgepoppt, der kein Windows 7 sondern xp hat. Alles Sch....! Naja vielleicht liegt das problem ja an was anderem und ihr könnt mir helfen. Aus diesem Grunde kopier ich euch mal den ganzen code rein. Aber bitte nicht schrecken, das ganze is ziemlich umfangreich und ich hoffe, dass ich als Hobbyprogrammierer das alles übersichtlich genug programmiert habe.
Es gibt noch weitere subs und functions, die in anderen Modulen stehen, die ich aber nicht angefügt habe, da sie nicht wichtig sind fürs Verständnis, wie ich denke. Zu Beginn des Makros wird ein Userform aufgerufen, dass sich frm_InsertSolarCell nennt. Beim schließen dieses Userforms wird die Sub Analysis aufgerufen.
Sub Analysis()
'Dim d_belst As Double, d_fläche As Double
'Dim n_zeile As Integer, n_zeile_1 As Integer
'Dim n_minimumMPP As Integer, n_Isc As Integer, n_Voc As Integer
'Dim d_helpIsc As Double, d_helpVoc As Double, d_minimum As Double
'Dim s_name As String, s_namebel As String, s_nameunbel As String
'Dim s_BrightFile As String, s_DarkFile As String
Application.ScreenUpdating = False
tab_Auswertung.Visible = xlSheetVisible
'Festlegen des Filenamens
'Call format_Date
's_FileName = frm_InsertSolarCell.cbo_Name.Text & "_" & s_Date & "_" & frm_InsertSolarCell.txt_Serie.Text
's_Path = Worksheets("Parameter").Range("PAR_Ordner").Text
'Auslesen der für die Berechnung relevanten Daten und der Importdateien
d_belst = frm_InsertSolarCell.txt_Belichtungsstärke.Value
d_fläche = frm_InsertSolarCell.txt_Fläche.Value
s_name = ActiveWorkbook.Name
s_DarkFile = frm_InsertSolarCell.txt_DarkCell.Text
s_BrightFile = frm_InsertSolarCell.txt_BrightCell.Text
'Einstellen der korrekten Dezimal- und Tausendertrennzeichen
'With Application
'.DecimalSeparator = "."
'.ThousandsSeparator = ","
'.UseSystemSeparators = False
'End With
'Alte Auswertedaten löschen
Worksheets("Auswertung").Range("A4:Z10004").ClearContents
'frm_ProgressBar.prb_Progressbar.Value = 5
'Öffnen des Messdatenfiles der unbelichteten Zelle
If s_DarkFile = "Falsch" Or s_DarkFile = "no" Then GoTo Skip_OpenDark
Set TabQ = Workbooks.Open(s_DarkFile)
'Workbooks.OpenText Filename:=s_DarkFile, Origin:=xlMSDOS, _
'StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
'ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
', Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
'Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
'Spannungswerte der unbelichteten Zelle in den CDL-MP übertragen
s_nameunbel = ActiveWorkbook.Name
Range(Cells(1, 3), Cells(1000, 3)).Copy (Workbooks(s_name).Worksheets("Auswertung").Cells(4, 11))
Skip_OpenDark:
'Öffnen des Messdatenfiles der belichteten Zelle
Set TabQ = Workbooks.Open(s_BrightFile)
'Workbooks.OpenText Filename:=s_BrightFile, Origin:=xlMSDOS, _
'StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
'ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
', Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
'Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
s_namebel = ActiveWorkbook.Name
'Spannungswerte der belichteten Zelle in den CDL-MP übertragen
's_nameunbel = ActiveWorkbook.Name
Range(Cells(1, 3), Cells(1000, 3)).Copy (Workbooks(s_name).Worksheets("Auswertung").Cells(4, 4))
'frm_ProgressBar.prb_Progressbar.Value = 15
For n_Zellenposition = 1 To 20
s_Zellenposition = n_Zellenposition
Workbooks(s_name).Sheets("Auswertung").Activate
Range(Cells(4, 5), Cells(10000, 5)).ClearContents
Workbooks(s_name).Worksheets("Auswertung").Range(Cells(4, 12), Cells(10000, 12)).ClearContents
'Stromwerte der belichteten Zelle in den CDL-MP übertragen
Windows(s_namebel).Activate
If Cells(1, n_Zellenposition + 3) = "0" And Cells(2, n_Zellenposition + 3) = "0" Then GoTo Skip_Cell
Range(Cells(1, n_Zellenposition + 3), Cells(1000, n_Zellenposition + 3)).Copy
Windows(s_name).Activate
Worksheets("Auswertung").Cells(4, 5).Select
ActiveSheet.Paste
'Stromwerte der unbelichteten Zelle in den CDL-MP übertragen
If s_DarkFile = "Falsch" Or s_DarkFile = "no" Then GoTo Skip_InsertDark
Windows(s_nameunbel).Activate
If Cells(1, n_Zellenposition + 3) = "0" And Cells(2, n_Zellenposition + 3) = "0" Then GoTo Skip_InsertDark
Range(Cells(1, n_Zellenposition + 3), Cells(1000, n_Zellenposition + 3)).Copy
Windows(s_name).Activate
Worksheets("Auswertung").Cells(4, 12).Select
ActiveSheet.Paste
Skip_InsertDark:
Call Berechnung
Call Diagramme
Call Insert_Celldata
Call Copy2Word
'frm_ProgressBar.prb_Progressbar.Value = frm_ProgressBar.prb_Progressbar.Value + 4
Skip_Cell:
Next n_Zellenposition
'Die Messfiles schließen
If s_DarkFile = "Falsch" Or s_DarkFile = "no" Then GoTo Skip_CloseDark
Windows(s_nameunbel).Close
Skip_CloseDark:
Windows(s_namebel).Close
'frm_ProgressBar.prb_Progressbar.Value = 100
frm_ProgressBar.Hide
tab_Auswertung.Visible = xlSheetHidden
Application.ScreenUpdating = True
End Sub
Sub Berechnung()
'***************************************************************************
'Sub Berechnung
'Zweck: Berechnung der charakteristischen Werte der Solarzelle
'Eingang: --
'Ausgang: --
'Ersteller: Christopher FRadler
'lezte Änderung: --
'Datum: 14.09.2011
'***************************************************************************
Workbooks(s_name).Activate
Worksheets("Auswertung").Select
d_helpVoc = 10000
d_helpIsc = 10000
d_minimum = 10000
'Die Werte für U/A und U*I ausrechnen - belichtete Zelle
For n_zeile = 4 To 30000 Step 1
If Cells(n_zeile, Range("AWT_Spannung_bel").Column) = "" Then Exit For
Cells(n_zeile, Range("AWT_Stromdichte_bel").Column) = Cells(n_zeile, Range("AWT_Strom_bel").Column) / d_fläche * 1000
Cells(n_zeile, Range("AWT_Power_bel").Column) = Cells(n_zeile, Range("AWT_Spannung_bel").Column) * Cells(n_zeile, Range("AWT_Stromdichte_bel").Column)
Cells(n_zeile, Range("AWT_ABSspannung_bel").Column) = Abs(Cells(n_zeile, Range("AWT_Spannung_bel").Column))
Cells(n_zeile, Range("AWT_ABSstromdichte_bel").Column) = Abs(Cells(n_zeile, Range("AWT_Stromdichte_bel").Column))
'Ermitteln von Voc, Isc, Vmpp und Impp - belichtete Zelle
If Cells(n_zeile, Range("AWT_Power_bel").Column) < d_minimum Then
d_minimum = Cells(n_zeile, Range("AWT_Power_bel").Column)
n_minimumMPP = n_zeile
End If
If Abs(Cells(n_zeile, Range("AWT_Spannung_bel").Column)) < d_helpIsc Then
d_helpIsc = Abs(Cells(n_zeile, Range("AWT_Spannung_bel").Column))
n_Isc = n_zeile
End If
If Abs(Cells(n_zeile, Range("AWT_Stromdichte_bel").Column)) < d_helpVoc Then
d_helpVoc = Abs(Cells(n_zeile, Range("AWT_Stromdichte_bel").Column))
n_Voc = n_zeile
End If
Next n_zeile
d_voc = Cells(n_Voc, Range("AWT_ABSspannung_bel").Column)
d_isc = Cells(n_Isc, Range("AWT_ABSstromdichte_bel").Column)
d_vmpp = Cells(n_minimumMPP, Range("AWT_ABSspannung_bel").Column)
d_impp = Cells(n_minimumMPP, Range("AWT_ABSstromdichte_bel").Column)
d_Vmin = Cells(4, Range("AWT_Spannung_bel").Column)
d_Vmax = Cells(n_zeile - 1, Range("AWT_Spannung_bel").Column)
'Signifikanz des Isc ermittlen
If d_isc <> 0 Then
d_grenze = 1
n_stelle = 0
Do Until d_isc > d_grenze
n_stelle = n_stelle + 1
d_grenze = d_grenze / 10
Loop
d_Uscale = Round(d_isc, n_stelle)
d_isc_round = Round(d_isc, n_stelle + 2)
End If
'Signifikanz des Impp ermitteln
If d_impp <> 0 Then
d_grenze = 1
n_stelle = 0
Do Until d_impp > d_grenze
n_stelle = n_stelle + 1
d_grenze = d_grenze / 10
Loop
d_impp_round = Round(d_impp, n_stelle + 2)
End If
'Signifikanz des Voc ermittlen
If d_voc <> 0 Then
d_grenze = 1
n_stelle = 0
Do Until d_voc > d_grenze
n_stelle = n_stelle + 1
d_grenze = d_grenze / 10
Loop
d_voc_round = Round(d_voc, n_stelle + 2)
End If
'Signifikanz des Vmpp ermitteln
If d_vmpp <> 0 Then
d_grenze = 1
n_stelle = 0
Do Until d_vmpp > d_grenze
n_stelle = n_stelle + 1
d_grenze = d_grenze / 10
Loop
d_vmpp_round = Round(d_vmpp, n_stelle + 2)
End If
'Die Werte für U/A und U*I ausrechnen - unbelichtete Zelle
If s_DarkFile = "Falsch" Or s_DarkFile = "no" Then GoTo Skip_calculation
Worksheets("Auswertung").Select
For n_zeile_1 = 4 To 30000 Step 1
If Cells(n_zeile_1, Range("AWT_Strom_dark").Column) = "" And Cells(n_zeile_1 + 1, Range("AWT_Strom_dark").Column) = "" Then Exit For
Cells(n_zeile_1, Range("AWT_Stromdichte_dark").Column) = Cells(n_zeile_1, Range("AWT_Strom_dark").Column) / d_fläche * 1000
Cells(n_zeile_1, Range("AWT_Power_dark").Column) = Cells(n_zeile_1, Range("AWT_Spannung_dark").Column) * Cells(n_zeile_1, Range("AWT_Stromdichte_dark").Column)
Cells(n_zeile_1, Range("AWT_ABSspannung_dark").Column) = Abs(Cells(n_zeile_1, Range("AWT_Spannung_dark").Column))
Cells(n_zeile_1, Range("AWT_ABSstromdichte_dark").Column) = Abs(Cells(n_zeile_1, Range("AWT_Stromdichte_dark").Column))
Next n_zeile_1
Skip_calculation:
If d_voc <> 0 Then
d_FF = d_impp * d_vmpp / (d_isc * d_voc) * 100
Else: d_FF = 0
End If
d_eff = d_voc * d_isc * d_FF / d_belst
'Signifikanz der eff ermitteln
If d_eff <> 0 Then
d_grenze = 1
n_stelle = 0
Do Until d_eff > d_grenze
n_stelle = n_stelle + 1
d_grenze = d_grenze / 10
Loop
d_eff_round = Round(d_eff, n_stelle + 2)
'Signifikanz des FF
d_FF_round = Round(d_FF, 1)
End If
End Sub
Sub Diagramme()
'***************************************************************************
'Sub Diagramme
'Zweck: Erstellen der I/U-Diagramme mit passender Formatierung
'Eingang: --
'Ausgang: --
'Ersteller: Christopher FRadler
'lezte Änderung: --
'Datum: 14.09.2011
'***************************************************************************
'erstellen der Diagramme
Worksheets("Diagramme").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).XValues = "=Auswertung!R4C4:R" & n_zeile - 1 & "C4"
ActiveChart.SeriesCollection(1).Values = "=Auswertung!R4C6:R" & n_zeile - 1 & "C6"
If s_DarkFile = "Falsch" Or s_DarkFile = "no" Then GoTo Skip_chart
If Sheets("Auswertung").Cells(n_zeile_1, Range("AWT_Strom_dark").Column) = "" And Cells(n_zeile_1 + 1, Range("AWT_Strom_dark").Column) = "" Then GoTo Skip_chart
ActiveChart.SeriesCollection(2).XValues = "=Auswertung!R4C11:R" & n_zeile_1 - 1 & "C11"
ActiveChart.SeriesCollection(2).Values = "=Auswertung!R4C13:R" & n_zeile_1 - 1 & "C13"
Skip_chart:
ActiveChart.ChartArea.Select
ActiveChart.Shapes("Text Box 2").Select
Selection.Characters.Text = _
"VOC=" & d_voc_round & " [V]" & Chr(10) & "ISC=" & d_isc_round & " [mA/cm²]" & Chr(10) & _
"VMPP=" & d_vmpp_round & " [V]" & Chr(10) & "IMPP=" & d_impp_round & " [mA/cm²]" & Chr(10) & _
"FF=" & d_FF_round & " [%]" & Chr(10) & _
ChrW(951) & "=" & d_eff_round & " [%]"
Selection.AutoScaleFont = False
'Formatierung der Diagramme
With Selection.Characters(Start:=1, Length:=107).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = True
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'Skalierung der Y-Achse
With ActiveChart.Axes(xlValue)
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
If b_Scale = True Then
.MinimumScale = frm_InsertSolarCell.txt_Min
.MaximumScale = frm_InsertSolarCell.txt_Max
Else
If b_StandardScale = True Then
.MinimumScale = -15
.MaximumScale = 10
Else
.MinimumScale = -d_Uscale * 2
.MaximumScale = d_Uscale * 3
End If
End If
End With
'Skalierung der Y-Achse
If d_Vmax > d_Vmin Then
d_Xmax = d_Vmax
d_Xmin = d_Vmin
Else
d_Xmax = d_Vmin
d_Xmin = d_Vmax
End If
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.NumberFormat = "0.0"
With ActiveChart.Axes(xlCategory)
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
If b_Scale_X = True Then
.MinimumScale = frm_InsertSolarCell.txt_Min_X
.MaximumScale = frm_InsertSolarCell.txt_Max_X
Else
If b_StandardScale_X = True Then
.MinimumScale = -0.5
.MaximumScale = 1
Else
.MinimumScale = d_Xmin
.MaximumScale = d_Xmax
End If
End If
End With
ActiveChart.ChartArea.Select
End Sub
Sub Insert_Celldata()
Sheets("Solarzellen").Select
n_LastRowNr = GetLastRowNumber("Solarzellen", Range("SC_Operator").Column, 3)
'Call format_Date
's_FileName = frm_InsertSolarCell.cbo_Name.Text & "_" & s_Date & "_" & frm_InsertSolarCell.txt_Serie.Text
Cells(n_LastRowNr, Range("SC_Filename").Column) = s_FileName
Cells(n_LastRowNr, Range("SC_Operator").Column) = frm_InsertSolarCell.cbo_Name.Text
Cells(n_LastRowNr, Range("SC_Datum").Column) = frm_InsertSolarCell.txt_Datum.Value
Cells(n_LastRowNr, Range("SC_Serie").Column) = frm_InsertSolarCell.txt_Serie.Text
Cells(n_LastRowNr, Range("SC_Device").Column) = frm_InsertSolarCell.cbo_Device.Text
Cells(n_LastRowNr, Range("SC_Pos").Column) = n_Zellenposition
Cells(n_LastRowNr, Range("SC_Typ").Column) = frm_InsertSolarCell.cbo_Typ.Text
Cells(n_LastRowNr, Range("SC_Organik").Column) = frm_InsertSolarCell.cbo_Organik.Text
Cells(n_LastRowNr, Range("SC_Anorganik").Column) = frm_InsertSolarCell.cbo_Anorganik.Text
Cells(n_LastRowNr, Range("SC_Elektrode2").Column) = frm_InsertSolarCell.cbo_Elektrode2.Text
Cells(n_LastRowNr, Range("SC_Zschicht").Column) = frm_InsertSolarCell.cbo_Zschicht.Text
Cells(n_LastRowNr, Range("SC_Fläche").Column) = frm_InsertSolarCell.txt_Fläche.Text
Cells(n_LastRowNr, Range("SC_Belichtungsstärke").Column) = frm_InsertSolarCell.txt_Belichtungsstärke.Text
Cells(n_LastRowNr, Range("SC_PolyCharge").Column) = frm_InsertSolarCell.cbo_PolyCharge.Text
Cells(n_LastRowNr, Range("SC_IndiumCharge").Column) = frm_InsertSolarCell.cbo_IndiumCharge.Text
Cells(n_LastRowNr, Range("SC_KupferCharge").Column) = frm_InsertSolarCell.cbo_KupferCharge.Text
Cells(n_LastRowNr, Range("SC_Temp").Column) = frm_InsertSolarCell.txt_Temp.Text
Cells(n_LastRowNr, Range("SC_DruckT").Column) = frm_InsertSolarCell.txt_DruckT.Text
Cells(n_LastRowNr, Range("SC_Druck").Column) = frm_InsertSolarCell.txt_Druck.Text
Cells(n_LastRowNr, Range("SC_Kommentar").Column) = frm_InsertSolarCell.txt_Kommentar.Text
Cells(n_LastRowNr, Range("SC_ID").Column) = Cells(n_LastRowNr - 1, Range("SC_ID").Column) + 1
'Daten der Auswertung eintragen
Cells(n_LastRowNr, Range("SC_VOC").Column) = d_voc
Cells(n_LastRowNr, Range("SC_ISC").Column) = d_isc
Cells(n_LastRowNr, Range("SC_VMPP").Column) = d_vmpp
Cells(n_LastRowNr, Range("SC_IMPP").Column) = d_impp
Cells(n_LastRowNr, Range("SC_FF").Column) = d_FF
Cells(n_LastRowNr, Range("SC_Eff").Column) = d_eff
End Sub
Sub Copy2Word()
Application.ScreenUpdating = False
Call CheckPath(s_Path)
'If n_CellsCounter = 1 And n_Zellenposition = 1 Then
If b_WordDone = False Then
b_WordDone = True
Set app_word = CreateObject("word.application").Documents.Add(Worksheets("Parameter").Range("PAR_Template").Text).Application
With app_word
'Eingabedaten in das Production Sheet übernehmen
.ActiveDocument.CustomDocumentProperties("Datum") = frm_InsertSolarCell.txt_Datum.Text
.ActiveDocument.CustomDocumentProperties("Name") = frm_InsertSolarCell.cbo_Name.Text
.ActiveDocument.CustomDocumentProperties("Polymer") = frm_InsertSolarCell.cbo_Organik.Text
.ActiveDocument.CustomDocumentProperties("Anorganik") = frm_InsertSolarCell.cbo_Anorganik.Text
.ActiveDocument.CustomDocumentProperties("Sample") = s_FileName
.ActiveDocument.CustomDocumentProperties("Typ") = frm_InsertSolarCell.cbo_Typ.Text
.ActiveDocument.CustomDocumentProperties("Date") = Date
.ActiveDocument.CustomDocumentProperties("Elektrode2") = frm_InsertSolarCell.cbo_Elektrode2.Text
.ActiveDocument.CustomDocumentProperties("Zschicht") = frm_InsertSolarCell.cbo_Zschicht.Text
.ActiveDocument.CustomDocumentProperties("Temp") = frm_InsertSolarCell.txt_Temp.Text
.ActiveDocument.CustomDocumentProperties("IndiumCharge") = frm_InsertSolarCell.cbo_IndiumCharge.Text
.ActiveDocument.CustomDocumentProperties("KupferCharge") = frm_InsertSolarCell.cbo_KupferCharge.Text
.ActiveDocument.CustomDocumentProperties("PolyCharge") = frm_InsertSolarCell.cbo_PolyCharge.Text
.ActiveDocument.CustomDocumentProperties("Druck") = frm_InsertSolarCell.txt_Druck.Text
.ActiveDocument.CustomDocumentProperties("DruckT") = frm_InsertSolarCell.txt_DruckT.Text
'Dokument zum ersten Mal abspeichern
.ActiveDocument.SaveAs Filename:=s_Path & s_FileName, FileFormat:=wdFormatDocument
End With
End If
With app_word
'Zellname als Überschrift einfügen, Diagramme kopieren und anhängen
.Selection.Move unit:=wdStory, Count:=1
.Selection.InsertBreak Type:=wdPageBreak
.Selection.Style = .ActiveDocument.Styles("Überschrift 1")
.Selection.TypeText Text:=frm_InsertSolarCell.txt_Serie.Text & "_" & frm_InsertSolarCell.cbo_Device.Text & "_" & s_Zellenposition
.Selection.TypeParagraph
.Selection.TypeText Text:=frm_InsertSolarCell.txt_Kommentar.Text
Sheets("Diagramme").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:= _
xlPicture
.Selection.TypeParagraph
'.Selection.MoveDown unit:=wdLine 'stattdessen Enter eintragen
Application.Wait (Now + TimeValue("0:00:01"))
.Selection.Paste 'AndFormat (wdChartPicture)
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.ChartArea.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:= _
xlPicture
.Selection.TypeParagraph
'.Selection.MoveDown unit:=wdLine 'stattdessen Enter eintragen
Application.Wait (Now + TimeValue("0:00:01"))
.Selection.Paste 'AndFormat (wdChartPicture)
End With
Sheets("Solarzellen").Select
Cells(n_LastRowNr, Range("SC_Filename").Column).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=s_Path & s_FileName & ".doc", TextToDisplay:= _
s_FileName
'Application.ScreenUpdating = False
End Sub
Sub SaveWord()
Application.ScreenUpdating = True
Call RefreshFields
With app_word
.ActiveDocument.Save
.Application.Quit
End With
End Sub
Viel Spaß beim lesen. :-)
Danke auf jeden Fall!!!
LG
|