Vedel by mi niekto poradiť ako dosadiť progress bar do môjho makra aby mi ukazovalo priebeh aj percentuálne aj graficky?
Už 2 deň hľadám vhodný návod, ako to dosadiť do môjho makra, len akosi sa mi to nedarí.Neviem ako dosadiť do makra nejaké značky alebo čosi podobné,
aby to vedelo spravne ukazovať priebeh.
Chcel by som použiť progress bar priložený v prílohe:
Pomôžete mi to tam nejako napasovať ?
Kód: Vybrat vše
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Sub QHC_ZAPIS()
Dim a As Integer
Dim FirstBlankCell, FirstBlankCell1, FirstBlankCell2, FirstBlankCell3 As Range
Dim SHNM As Variant
Dim i As Integer
a = 1
SHNM = ActiveSheet.Range("f10").Value
If ActiveSheet.Range("l6") = "" Then
GoTo SPRAVA
Else: GoTo DALEJ
End If
If ActiveSheet.Range("l7") = "" Then
GoTo SPRAVA
Else: GoTo DALEJ
End If
If ActiveSheet.Range("F9") = "" Then
GoTo SPRAVA
Else: GoTo DALEJ
End If
If ActiveSheet.Range("F10") = "" Then
GoTo SPRAVA
Else: GoTo DALEJ
End If
If ActiveSheet.Range("F7") = "" Then
GoTo SPRAVA
Else: GoTo DALEJ
End If
SPRAVA:
MsgBox ("PROSÍM VYPLŇTE VŠETKY ÚDAJE NA REPORTE"), vbCritical
Exit Sub
DALEJ:
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Application.ScreenUpdating = False
'DELIVERY DATE
ActiveSheet.Range("l6").Copy
Sheets("pomocny_list").Range("B1").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
'DELIVERY QUANTITY
ActiveSheet.Range("L7").Copy
Sheets("pomocny_list").Range("B2").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
'PART NAME
ActiveSheet.Range("f9").Copy
Sheets("pomocny_list").Range("B3").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
'PART NOMBER
ActiveSheet.Range("f10").Copy
Sheets("pomocny_list").Range("B4").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
'SUPPLIER
ActiveSheet.Range("f7").Copy
Sheets("pomocny_list").Range("B5").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
If Not IsFileOpen("C:\Documents and Settings\user\Dokumenty\Forma reportov_all\prepojene subory\quality history card.xlsb") Then
Workbooks.Open FileName:="C:\Documents and Settings\user\Dokumenty\Forma reportov_all\prepojene subory\quality history card.xlsb"
End If
Windows("quality history card.xlsb").Activate
For Each Sheet In ActiveWorkbook.Sheets
If UCase(Sheet.Name) = UCase(SHNM) Then
Sheets(SHNM).Activate
GoTo kopiruj
Exit Sub
End If
Next
'If Not bWorksheetExists(SHNM) Then
'Sheet does not exist
'do something
' GoTo vytvor_list
'Else
'Sheet exists
' Sheets(SHNM).Activate
'GoTo kopiruj
'End If
vytvor_list:
'For i = Sheets.Count To 1 Step -1
Sheets("VZOR").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = SHNM
Range("a6:a65536").Select
Selection.NumberFormat = "dd/mm/yyyy"
Range("b6:b65536").Select
Selection.NumberFormat = "dd/mm/yyyy"
Range("c6:c65536").Select
Selection.NumberFormat = "General"
'Next
'Range("c3").ClearContents
'Range("c4").ClearContents
'Range("f3").ClearContents
kopiruj:
Application.ScreenUpdating = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Sheets("pomocny_list").Range("B4").Copy
Windows("quality history card.xlsb").Activate
Sheets(SHNM).Range("c3").Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Sheets("pomocny_list").Range("B3").Copy
Windows("quality history card.xlsb").Activate
Sheets(SHNM).Range("c4").Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Sheets("pomocny_list").Range("A10").Copy
Windows("quality history card.xlsb").Activate
Set FirstBlankCell3 = Range("a65536").End(xlUp).Offset(1, 0)
FirstBlankCell3.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Sheets("pomocny_list").Range("b5").Copy
Windows("quality history card.xlsb").Activate
Sheets(SHNM).Range("f3").Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Sheets("pomocny_list").Range("B1").Copy
Windows("quality history card.xlsb").Activate
Set FirstBlankCell = Range("b65536").End(xlUp).Offset(1, 0)
FirstBlankCell.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Sheets("pomocny_list").Range("B2").Copy
Windows("quality history card.xlsb").Activate
Set FirstBlankCell1 = Range("c65536").End(xlUp).Offset(1, 0)
FirstBlankCell1.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
Sheets("pomocny_list").Range("B5").Copy
Windows("quality history card.xlsb").Activate
Set FirstBlankCell2 = Range("d65536").End(xlUp).Offset(1, 0)
FirstBlankCell2.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FORMA REPORTOV_GEN_MAKRO.XLSM").Activate
koniec:
End Sub
