Thema Datum  Von Nutzer Rating
Antwort
07.10.2011 14:17:32 Chris
NotSolved
07.10.2011 14:28:02 Chris
NotSolved
08.10.2011 01:35:52 Till
NotSolved
08.10.2011 01:35:57 Till
NotSolved
10.10.2011 09:34:26 Gast77203
NotSolved
10.10.2011 13:01:06 Dekor
NotSolved
10.10.2011 15:44:43 Chris
NotSolved
10.10.2011 15:44:46 Chris
NotSolved
10.10.2011 19:19:51 Till
NotSolved
11.10.2011 12:12:03 Dekor
NotSolved
11.10.2011 20:57:46 Till
NotSolved
12.10.2011 12:32:45 Dekor
NotSolved
17.10.2011 11:57:46 Chris
NotSolved
17.10.2011 12:11:09 Dekor
NotSolved
17.10.2011 12:25:16 Dekor
NotSolved
17.10.2011 12:44:21 Dekor
NotSolved
17.10.2011 16:41:50 Till
NotSolved
Blau Excel-Diagramm in ein Word-File kopieren
 18.10.2011 13:53:29 Chris
NotSolved
24.10.2011 11:28:36 Gast72363
NotSolved
24.10.2011 12:30:10 Dekor
NotSolved

Ansicht des Beitrags:
Von:
Chris		 Datum:
18.10.2011 13:53:29		 Views:
2104		 Rating:
     
Antwort:
  Ja
Thema:
Excel-Diagramm in ein Word-File kopieren

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.

 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
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

 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
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
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
07.10.2011 14:17:32 Chris
NotSolved
07.10.2011 14:28:02 Chris
NotSolved
08.10.2011 01:35:52 Till
NotSolved
08.10.2011 01:35:57 Till
NotSolved
10.10.2011 09:34:26 Gast77203
NotSolved
10.10.2011 13:01:06 Dekor
NotSolved
10.10.2011 15:44:43 Chris
NotSolved
10.10.2011 15:44:46 Chris
NotSolved
10.10.2011 19:19:51 Till
NotSolved
11.10.2011 12:12:03 Dekor
NotSolved
11.10.2011 20:57:46 Till
NotSolved
12.10.2011 12:32:45 Dekor
NotSolved
17.10.2011 11:57:46 Chris
NotSolved
17.10.2011 12:11:09 Dekor
NotSolved
17.10.2011 12:25:16 Dekor
NotSolved
17.10.2011 12:44:21 Dekor
NotSolved
17.10.2011 16:41:50 Till
NotSolved
Blau Excel-Diagramm in ein Word-File kopieren
 18.10.2011 13:53:29 Chris
NotSolved
24.10.2011 11:28:36 Gast72363
NotSolved
24.10.2011 12:30:10 Dekor
NotSolved