mysticmario
Active Member
- Joined
- Nov 10, 2021
- Messages
- 323
- Office Version
- 365
- Platform
- Windows
Hi,
I'm coming back to you with userform exporting issue once again.
Below macro creates new workbook with userform from previous workbook amongst other things
so it export temporary userform files and then imports them into new workbook.
Entire code works works great on my PC.
Unfortunately on other PCs i get error at line
Run-time error 1004
Application-defined or object-defined error
It is sort of like it does not find those useforms there
I'm loosing my mind over this cause i worked on this script for days, upgraded it with newer and newer functions but i always tested this on my PC, now when I need it to run for soemone else it breaks.... help please
I'm coming back to you with userform exporting issue once again.
Below macro creates new workbook with userform from previous workbook amongst other things
so it export temporary userform files and then imports them into new workbook.
Entire code works works great on my PC.
Unfortunately on other PCs i get error at line
srcWB.VBProject.VBComponents("kartaR").Export _
Run-time error 1004
Application-defined or object-defined error
It is sort of like it does not find those useforms there
VBA Code:
Sub ZapiszWchmurze_Click()
ActiveSheet.Unprotect
Dim wbname As String, wbaddress As String
Dim wbOrig As Workbook, wbnew As Workbook
Dim shtNames As Variant, sName As Variant
Dim wbname2 As String
Dim sheetName As String
Dim usercheck As String
Dim pathStorage As String
Dim lr As Long
sheetName = ActiveSheet.Name
lr = 3
Application.ScreenUpdating = False
Set wbOrig = ThisWorkbook
wbname = ActiveSheet.Name
usercheck = InputBox("Wpisz ponownie hasło", "PODAJ HASŁO")
If usercheck = "witek" Then
wbaddress = wbOrig.Worksheets("Admin").Range("A25").Value
Sheets("ZESTAWIENIE WYCEN").Cells(lr + 1, "B").Value = sheetName
Sheets("ZESTAWIENIE WYCEN").Cells(lr + 1, "C").Value = Sheets(sheetName).Range("D16").Value
ElseIf usercheck = "konrad" Then
wbaddress = wbOrig.Worksheets("Admin").Range("A26").Value
Sheets("ZESTAWIENIE WYCEN").Cells(lr + 1, "G").Value = sheetName
Sheets("ZESTAWIENIE WYCEN").Cells(lr + 1, "H").Value = Sheets(sheetName).Range("D16").Value
ElseIf usercheck = "damian" Then
wbaddress = wbOrig.Worksheets("Admin").Range("A27").Value
Sheets("ZESTAWIENIE WYCEN").Cells(lr + 1, "L").Value = sheetName
Sheets("ZESTAWIENIE WYCEN").Cells(lr + 1, "M").Value = Sheets(sheetName).Range("D16").Value
ElseIf usercheck = "admin" Then
wbaddress = wbOrig.Worksheets("Admin").Range("A28").Value
Else
MsgBox "Nieprawidłowe hasło"
Exit Sub
MsgBox wbaddress
End If
wbname2 = InputBox("Podaj nazwę", "Nazwa pliku")
'wbaddress = wbOrig.Worksheets("PANEL WYCEN").Range("H17").Value
shtNames = Array("MAG", "SZABLON_SZAFA", "KARTA REALIZACJI", "OFERTA", "Admin", wbname)
Dim srcWB As Workbook
Dim destWb As Workbook
Dim sStr As String
sStr = wbaddress & "\" & tempFile & ".frm"
Set wbnew = Workbooks.Add(xlWBATWorksheet) 'Create new wb with a single blank sheet
wbOrig.Activate
Set srcWB = ThisWorkbook
Set destWb = wbnew
'get kartaR'
srcWB.VBProject.VBComponents("kartaR").Export _
Filename:=sStr
destWb.VBProject.VBComponents.Import _
Filename:=sStr
Kill sStr
'get mag'
srcWB.VBProject.VBComponents("wyszukiwarka").Export _
Filename:=sStr
destWb.VBProject.VBComponents.Import _
Filename:=sStr
Kill sStr
For Each sName In shtNames
wbOrig.Worksheets(sName).Copy After:=wbnew.Worksheets(wbnew.Sheets.Count)
Next sName
Application.DisplayAlerts = False
wbnew.Worksheets(1).Delete
'wbOrig.Worksheets(wbname).Delete
wbnew.SaveAs Filename:=wbaddress & "\" & wbname2 & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'wbNew.Close savechanges:=False '<--- Uncomment this if you want to close the new workbook
wbnew.Worksheets("MAG").Visible = xlSheetVeryHidden
wbnew.Worksheets("KARTA REALIZACJI").Visible = xlSheetVeryHidden
wbnew.Worksheets("SZABLON_SZAFA").Visible = xlSheetVeryHidden
wbnew.Worksheets("Admin").Visible = xlSheetVeryHidden
wbnew.Worksheets(sheetName).Buttons.Delete
Dim i As Integer
Dim sheetNumber As String
sheetName = ThisWorkbook.ActiveSheet.Name
sheetNumber = ThisWorkbook.ActiveSheet.CodeName & "."
i = 0
i = i + 1
Call Create_Button(sheetName, "D1:E1", "Zapisz i zakończ", sheetNumber + "ZapiszWchmurze_Click", i)
i = i + 1
Call Create_Button(sheetName, "G1:H1", "Sprawdź magazyn", sheetNumber + "magazyn_Click", i)
i = i + 1
Call Create_Button(sheetName, "J1:L1", "Utwórz plik precyzyjnej wyceny", sheetNumber + "fullprice_Click", i)
i = i + 1
Call Create_Button(sheetName, "M1:N1", "Utwórz kartę realizacji", sheetNumber + "kartarealizacji_Click", i)
i = i + 1
Call Create_Button(sheetName, "R2:S2", "POLSKA", sheetNumber + "polska_Click", i)
i = i + 1
Call Create_Button(sheetName, "U2:V2", "WIELKA BRYTANIA", sheetNumber + "anglia_Click", i)
'wbNew.Close savechanges:=False '<--- Uncomment this if you want to close the new workbook
Application.DisplayAlerts = False
wbnew.ActiveSheet.Buttons("button_3").Visible = True
wbnew.ActiveSheet.Buttons("button_4").Visible = False
wbnew.ActiveSheet.Buttons("button_1").Visible = False
ActiveSheet.Protect
End Sub
I'm loosing my mind over this cause i worked on this script for days, upgraded it with newer and newer functions but i always tested this on my PC, now when I need it to run for soemone else it breaks.... help please