Új hozzászólás Aktív témák

• #47915 eszgé100 őstag Fferi50 #47894

  Új Válasz 2021-12-01 10:44:47 #47915

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  eszgé100

  őstag

  válasz Fferi50 #47894 üzenetére

  1.) pontosan,  ott nem kell bezárni a fájlt, mert még a ciklus későbbi lépéseiben még szükség lesz rájuk, pl amikor egy workbookban van 20 worksheet,  de nem egyszerre ömlesztve akarom őket kinyomtatni, mert utána akkor még kézzel is le kell válogatnom később, amit nem szeretnék. A Save&Close oszlop celláinak értéke az =IF(COUNTIF(D2:INDIRECT("D" & COUNTIF(D,"<>")),D2)>1,"no","yes") függvénnyel van meghatározva, ami eddigi tesztjeim alapján dinamikusan változik, amikor ugyanaz az elérési útvonal kerül a Path oszlop celláiba. Amennyiben az adott elérési útvonal nem ismétlődik többet a maradék cellatartományban az érték Save&Close "yes"-re változik és a workbook ment és bezárul

  2a.) mi pontosan a hátránya, hogyha GoTo-val ugrálok? 
  2b.) Másik ezzel kapcsolatban, hogy a Mod funkció működését nem teljesen értem, legalábbis az én esetemben. Pl ha "6 monthly"-t keresem, akkor azokat a hónapokat keresem, amelyeket 6-al oszthatóak maradék 1-el? Ez január és július esetében (1/6= 0 maradék 1) és (7/6=1 maradék 1), "yearly" pedig (1/12=0 maradék 1)?
  2c.) címkéket megszűntettem if - end if-eket használva 

  3.) hibakezelés, pl valami létfontosságú cella nincs kitöltve. Szűrést pedig úgy értem, hogy  kézzel leszűröm az adatokat, majd arra eresztem rá a makrót, hiba a Save&Close-nál van, mert olyankor is a maradék tartományt figyeli, mikor az egyébként a szűrés miatt nem látszik.

  + A kódhoz hozzáadtam egy response-t, ami a user arcába tolja, hogy a makró milyen nyomtatókat fog használni, mindkettőt le kell okézni, csak így kerül az ellenörző cellába, ahonnan a makró majd használja. Ha valamelyik cella üres, akkor a kód megáll, és informálja a usert. Ezen kívül még hozzáadtam egy manual update oszlopot is az adattáblán, alapból ki van kapcsolva, de ha "yes" az értéke, akkor csak megnyitja a workbookot, majd megy tovább a ciklus, valamint egy néhány sort, hogy szűrést és manual update-et alaphelyzetbe állítsa miután a fájl megnyílik.

  így néznek ki:

  Sub Auto_Open()

Dim start As Date
Dim weekcom As Date
Dim today As Date
Dim response As VbMsgBoxResult

Dim lo As ListObject
Dim ws As Worksheet, ma As Worksheet
Dim lastrow As Long


Set lo = Worksheets("OpenClose").ListObjects(1)
lo.AutoFilter.ShowAllData

Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")
'ma.Unprotect "123"

Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("P2:P" & lastrow) = "no"



Worksheets("MainAssembly").Activate
Range("A1").Select

start = Sheets("MainAssembly").Range("F3").Value
today = Sheets("MainAssembly").Range("F7").Value
weekcom = start
Do While weekcom < today
weekcom = weekcom + 28
Loop
Sheets("MainAssembly").Range("F6").Value = weekcom

Dim Printers() As String
Dim N As Long
Dim S As String
Dim col As String
Dim bw As String

Printers = GetPrinterFullNames()

Sheets("MainAssembly").Range("F8:F9").Value = ""


For N = LBound(Printers) To UBound(Printers)
S = Printers(N) 'S & Printers(N) & vbNewLine
If InStr(S, "Microsoft") <> 0 And InStr(S, "Print") <> 0 Then col = S
If InStr(S, "HP Photosmart Wireless B109n-z") <> 0 And InStr(S, "Print") = 0 Then bw = S
Next N

response = MsgBox(col, vbOKCancel, "Confirm the Colour Printer")
If response = vbOK Then
Sheets("MainAssembly").Range("F8").Value = col
Else: MsgBox "Stop-Call-Wait", vbOKOnly
Exit Sub
End If

response = MsgBox(bw, vbOKCancel, "Confirm the B&W Printer")
If response = vbOK Then
Sheets("MainAssembly").Range("F9").Value = bw
Else: MsgBox "Stop-Call-Wait", vbOKOnly
Exit Sub
End If
'ma.Protect "123"
End Sub

  Sub EOM_Main_Assy_Workbooks()

'loop:
Dim sPath As String, ssheet As String, fileName As String
Dim lastrow As Long, counter As Long
Dim ws As Worksheet, tp As Worksheet, ma As Worksheet
'print:
Dim bw As String, col As String
Dim toprint As Boolean
'from main worksheet:
Dim sDate As String
Dim sWeek As String
Dim sWkcom As String
Dim nextmonth As Date
'from Table:
Dim freq As String
Dim area As String
Dim loc As String
Dim dat As String
Dim week As String
Dim wkcom As String
Dim procloc As String
Dim procname As String
Dim machloc As String
Dim machname As String
Dim printer As String
Dim copies As Integer
Dim saveandclose As String
Dim manual As String
Dim manualcheck As Boolean

sDate = "=[FillerPrinter.xlsm]MainAssembly!$F$4"
sWeek = "=[FillerPrinter.xlsm]MainAssembly!$F$5"
sWkcom = "=[FillerPrinter.xlsm]MainAssembly!$F$6"

Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")

nextmonth = ma.Range("F4")
col = ma.Range("F9")
bw = ma.Range("F9")

'1st condition
If ma.Range("F8") = "" Or ma.Range("F9") = "" Then
MsgBox prompt:="One or both printers are not selected." & VBA.Constants.vbNewLine & "Please click on Update / Reset button!" & VBA.Constants.vbNewLine & "If not sure, please S-C-W!"
Exit Sub
End If
'End of 1st condition

Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")

lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
manualcheck = False

Do While counter <= lastrow

'2nd condition
If Not ws.Range("A" & counter).EntireRow.Hidden Then

freq = ws.Range("A" & counter)
area = ws.Range("B" & counter)
loc = ws.Range("C" & counter)
sPath = ws.Range("D" & counter)
ssheet = ws.Range("E" & counter)
dat = ws.Range("F" & counter)
week = ws.Range("G" & counter)
wkcom = ws.Range("H" & counter)
procloc = ws.Range("I" & counter)
procname = ws.Range("J" & counter)
machloc = ws.Range("K" & counter)
machname = ws.Range("L" & counter)
printer = ws.Range("M" & counter)
copies = ws.Range("N" & counter)
saveandclose = ws.Range("O" & counter)
manual = ws.Range("P" & counter)

'freq check

Select Case CStr(freq)
Case "4 weekly", "monthly"
toprint = True
Case "2 monthly"
toprint = Month(nextmonth) Mod 2 = 1
Case "3 monthly"
toprint = Month(nextmonth) Mod 3 = 1
Case "6 monthly"
toprint = Month(nextmonth) Mod 6 = 1
Case "yearly"
toprint = Month(nextmonth) Mod 12 = 1
End Select

'open sheets
'3rd condition
If toprint Then
Application.ScreenUpdating = True
ma.Visible = True

fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
Application.StatusBar = "Processing File: " & fileName
Application.ScreenUpdating = False

Workbooks.Open sPath
Windows(fileName).Visible = False

'4th condition
If CStr(manual) = "no" Then

'update sheets if necessary
If CStr(dat) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(dat).Formula = sDate
If CStr(week) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(week).Formula = sWeek
If CStr(wkcom) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(wkcom).Formula = sWkcom
If CStr(procloc) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(procloc).Formula = procname
If CStr(machloc) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(machloc).Formula = machname


'print sheets
Set tp = Workbooks(fileName).Worksheets(CStr(ssheet))

Select Case CStr(printer)
Case "col"
Application.ActivePrinter = col
tp.PrintOut copies:=CStr(copies)
Case "bw"
Application.ActivePrinter = bw
tp.PrintOut copies:=CStr(copies)
Case Else
MsgBox "No printer selected"
End Select

'wait here a bit

Do While ActiveWindow.View = xlPrint
Loop

'time to save&close
If CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True



Else:
'Windows(fileName).Visible = True
manualcheck = True

'End of 4th condition
End If

'End of 3rd condition
End If

'End of 2nd condition
End If

counter = counter + 1
Loop

Application.StatusBar = "Done!"
Application.ScreenUpdating = True

ma.Activate
Range("A1").Select

If manualcheck = True Then
MsgBox "Update and print the sheets manually"
Else: MsgBox "Done!"
End If

End Sub

  "-Meddig tart a játék? -Amíg mindenkinek ki nem verik a fogát..."

Új hozzászólás Aktív témák