Moderatori: Anthony47, Flash30005
Private Sub ComboBox1_Change()
Language = ComboBox1.Value
Worksheets(2).Range("b1") = Language
End Sub
Private Sub ComboBox2_Change()
Cells(3, 4) = ComboBox2.Value
End Sub
Private Sub CommandButton1_Click()
' Formating of the texts in the file ADL_ES.xls
Range("a1").Select
Range("b7:k50").Interior.ColorIndex = 2 'white
With Range("b7:k50").Font
.ColorIndex = 37 'bright blue
.Bold = True
End With
Range("b10:k11").Interior.ColorIndex = 36 'yellow
With Range("b10:k11").Font
.ColorIndex = 5 'dark blue
.Bold = True
End With
With Range("d13:j32").Font
.ColorIndex = 1 'black
.Bold = False
End With
' Set buttons visible/unvisible
CommandButton1.Visible = False
CommandButton2.Visible = True
ComboBox1.Visible = False
End Sub
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
' Copying of the three basic files: ADL_ES.xls, day.xls, week.xls
Do
fName = Application.GetSaveAsFilename
Loop Until fName <> False
ActiveWorkbook.SaveAs Filename:=fName
FileCopy "c:\ADL\day.xls", ActiveWorkbook.Path & "\day.xls"
FileCopy "c:\ADL\week.xls", ActiveWorkbook.Path & "\week.xls"
' Open file day.xls
Workbooks.Open "day.xls", 0
Workbooks(1).Activate
' Execute of the makro DAT_OPEN (Modul1)
i = 1
ActiveSheet.Cells(3, 3).Value = i
Application.Run "'ADL_ES.xls'!DAT_OPEN"
' Change of the language in the file "Operating_modes" (on/off/idle running)
Workbooks(1).Activate
AUS = Worksheets(2).Range("b124").Text
LL = Worksheets(2).Range("b125").Text
EIN = Worksheets(2).Range("b126").Text
GES = EIN & Chr(10) & LL & Chr(10) & AUS
Workbooks(2).Activate
Charts("Operating_modes").Activate
With Charts("Operating_modes")
.Shapes("Text Box 10").Select
Selection.Characters.Text = GES
.Shapes("Text Box 11").Select
Selection.Characters.Text = GES
.Shapes("Text Box 12").Select
Selection.Characters.Text = GES
.Shapes("Text Box 13").Select
Selection.Characters.Text = GES
.Shapes("Text Box 14").Select
Selection.Characters.Text = GES
.Shapes("Text Box 15").Select
Selection.Characters.Text = GES
End With
' Show active printer in Message-Box
Workbooks(1).Activate
Msg1 = Worksheets(2).Range("b71").Value
Msg2 = Worksheets(2).Range("b72").Value
MsgBox Msg1 & Chr(13) & Chr(13) & Application.ActivePrinter & Chr(13) & Chr(13) & Msg2
' Formating of the texts in the file ADL_ES.xls
Range("a1").Select
Range("b7:k50").Interior.ColorIndex = 2 'white
With Range("b7:k50").Font
.ColorIndex = 37 'bright blue
.Bold = True
End With
Range("b12:k32").Interior.ColorIndex = 36 'yellow
With Range("b12:k32").Font
.ColorIndex = 5 'dark blue
.Bold = True
End With
With Range("d13:j32").Font
.ColorIndex = 1 'black
.Bold = False
End With
' Set buttons visible/unvisible
CommandButton2.Visible = False
CommandButton3.Visible = True
ActiveSheet.Range("e13").Select
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
' ' Formating of the texts in the file ADL_ES.xls
Range("a1").Select
Range("b7:k50").Interior.ColorIndex = 2 'white
With Range("b7:k50").Font
.ColorIndex = 37 'bright blue
.Bold = True
End With
Range("b33:k40").Interior.ColorIndex = 36 'yellow
With Range("b33:k40").Font
.ColorIndex = 5 'dark blue
.Bold = True
End With
With Range("d13:j32").Font
.ColorIndex = 1 'black
.Bold = False
End With
' Set buttons visible/unvisible
CommandButton3.Visible = False
CommandButton4.Visible = True
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
' Save day 01 as xls file
Workbooks(1).Activate
b = ActiveSheet.Cells(3, 5).Value
c = ActiveSheet.Cells(3, 6).Value
cd = ActiveSheet.Cells(3, 4).Value
Workbooks(2).Activate
ActiveWorkbook.SaveAs b
' Print diagrams day 01
If cd = 0 Then
Else
Workbooks(2).Activate
Charts("Air_flow").PrintOut copies:=cd
Charts("Operating_modes").PrintOut copies:=cd
Charts("Current").PrintOut copies:=cd
End If
'Execute makro DAT_OPEN
Workbooks(1).Activate
Dim i
For i = 2 To 7
Workbooks(1).Activate
ActiveSheet.Cells(3, 3).Value = i
Application.Run "'ADL_ES.xls'!DAT_OPEN"
Next i
Workbooks(2).Close SaveChanges:=False
' W E E K L Y C U R V E S
' =========================
' In case that day is not existing, create new blank workbook
If Dir("Mon.xls") = "" Then
Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="Mon.xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets(1).Range("f3").Value = "blank file"
End If
If Dir("Tue.xls") = "" Then
Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="Tue.xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets(1).Range("f3").Value = "blank file"
End If
If Dir("Wed.xls") = "" Then
Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="Wed.xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets(1).Range("f3").Value = "blank file"
End If
If Dir("Thu.xls") = "" Then
Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="Thu.xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets(1).Range("f3").Value = "blank file"
End If
If Dir("Fri.xls") = "" Then
Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="Fri.xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets(1).Range("f3").Value = "blank file"
End If
If Dir("Sat.xls") = "" Then
Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="Sat.xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets(1).Range("f3").Value = "blank file"
End If
If Dir("Sun.xls") = "" Then
Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="Sun.xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets(1).Range("f3").Value = "blank file"
End If
' Open week.xls
Workbooks.Open "week.xls", 3
' Cummulative flow
Workbooks(2).Activate
Worksheets(2).Activate
ActiveSheet.Range("j8:j343").Copy
ActiveSheet.Range("k8").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Range("k8:k343").Select
Selection.Sort Key1:=ActiveSheet.Range("k8"), Order1:=xlDescending
' Definition of variables for formating of the diagrams
Workbooks(1).Activate
Lieferm = Worksheets(2).Range("b201").Text
Betriebsz = Worksheets(2).Range("b202").Text
WochenstE = Worksheets(2).Range("b203").Text
Lastlauf = Worksheets(2).Range("b204").Text
Leerlauf = Worksheets(2).Range("b205").Text
Volumen = Worksheets(2).Range("b206").Text
VolumenE = Worksheets(2).Range("b207").Text
Wochenst = Worksheets(2).Range("b208").Text
Summenh = Worksheets(2).Range("b209").Text
' Formating of the diagrams
Workbooks(2).Activate
With Charts("Cummulative_frequency")
.ChartTitle.Text = Summenh
.Axes(xlCategory).AxisTitle.Text = Wochenst
.Axes(xlValue).AxisTitle.Text = VolumenE
End With
With Charts("Air_flow")
.ChartTitle.Text = Volumen
.Axes(xlCategory).AxisTitle.Text = Wochenst
.Axes(xlValue).AxisTitle.Text = VolumenE
End With
With Charts("Operating_conditions")
.ChartTitle.Text = Betriebsz
.SeriesCollection(1).Name = Leerlauf
.SeriesCollection(2).Name = Lastlauf
.Axes(xlValue).AxisTitle.Text = WochenstE
End With
With Charts("Res_Air_flow")
.ChartTitle.Text = Lieferm
End With
' Formating of the texts in the file ADL_ES.xls
Workbooks(1).Activate
Range("a1").Select
Range("b7:k50").Interior.ColorIndex = 2 'white
With Range("b7:k44").Font
.ColorIndex = 37 'bright blue
.Bold = True
End With
Range("b41:k44").Interior.ColorIndex = 36 'yellow
With Range("b41:k44").Font
.ColorIndex = 5 'dark blue
.Bold = True
End With
With Range("d13:j32").Font
.ColorIndex = 1 'black
.Bold = False
End With
' Set buttons visible/unvisible
CommandButton4.Visible = False
CommandButton5.Visible = True
' Scree updating
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton5_Click()
' Print weekly curves
cw = ComboBox3.Value
If cw = 0 Then
Else
Workbooks(2).Activate
Charts("Cummulative_frequency").PrintOut copies:=cw
Charts("Air_flow").PrintOut copies:=cw
Charts("Operating_conditions").PrintOut copies:=cw
Charts("Res_Air_flow").PrintOut copies:=cw
Worksheets(1).PrintOut copies:=cw
End If
' Close everything
Workbooks(2).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks(1).Close SaveChanges:=True
End Sub
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: Nessuno e 13 ospiti