Конвертор файлов .xls из выгруженых с 1с

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

Конвертор файлов .xls из выгруженых с 1с (Excel)

DJ_Marker_MC

Дата: Четверг, 06.06.2013, 10:12 | Сообщение № 1

Группа: Друзья

Ранг: Ветеран

Сообщений: 991

Репутация: 213 ±

Замечаний: 0% ±

Excel 2019

Всем привет, сделал себе такую вот надстройку, может кому то еще пригодится. Спрашивается зачем? - если есть кнопка преобразовать в стандартных функциях офиса, но суть моей надстройки немного шире чем просто преобразовать))))

Когда сохраняем таблицу 1с в екселевский документ, то у нас, плюс ко всему, не видно ярлычки листов, чтоб их увидеть нужно лезть в настройки и включить птичку "показать Ярлычки листов", плюс потом, вручную растягивать горизонтальную полосу прокрутки... плюс лист подписан как Sheet1, вместо привычного Лист1... А ниже приведенный код который избавляет от этих мучений)))))
В личную книгу макросов, кнопку на панель быстрого доступа и вуаля!

[vba]

Код

Sub ConvertToXlsx()
     Dim s, newS As String
     Dim str1() As String
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
     str1 = Split(ActiveWorkbook.FullName, ".")
     Spliting = str1(UBound(str1))

     If Spliting = "xls" Then
         s = ActiveWorkbook.FullName
         newS = Replace(s, "xls", "xlsx")
         ActiveWorkbook.SaveAs newS, xlOpenXMLWorkbook
         ActiveWorkbook.Close
         Kill s
         Workbooks.Open (newS)

         With ActiveWindow
             .DisplayHorizontalScrollBar = False
             .DisplayWorkbookTabs = True
             .DisplayHorizontalScrollBar = True
             .TabRatio = 0.6
         End With

         Application.ReferenceStyle = xlA1
         If ActiveSheet.Name = "Sheet1" Then
             ActiveSheet.Name = "Лист1"
         End If
     End If
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
End Sub

[/vba]

Код

[/vba]DJ_Marker_MC

Ответить

СообщениеВсем привет, сделал себе такую вот надстройку, может кому то еще пригодится. Спрашивается зачем? - если есть кнопка преобразовать в стандартных функциях офиса, но суть моей надстройки немного шире чем просто преобразовать))))

Когда сохраняем таблицу 1с в екселевский документ, то у нас, плюс ко всему, не видно ярлычки листов, чтоб их увидеть нужно лезть в настройки и включить птичку "показать Ярлычки листов", плюс потом, вручную растягивать горизонтальную полосу прокрутки... плюс лист подписан как Sheet1, вместо привычного Лист1... А ниже приведенный код который избавляет от этих мучений)))))
В личную книгу макросов, кнопку на панель быстрого доступа и вуаля!

[vba]

Код

[/vba]

Автор - DJ_Marker_MC
Дата добавления - 06.06.2013 в 10:12

Serge_007

Дата: Четверг, 06.06.2013, 10:22 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Связанная статья:
Отображение листов в файлах, сформированных в 1С

ЮMoney:41001419691823 | WMR:126292472390

Ответить

DJ_Marker_MC

Дата: Четверг, 06.06.2013, 12:41 | Сообщение № 3

Группа: Друзья

Ранг: Ветеран

Сообщений: 991

Репутация: 213 ±

Замечаний: 0% ±

Excel 2019

Немного предложили подправить код, поскольку не учел некоторых факторов:
первое - если xls будет не только расширение, но и последовательность в имени, его также изменит на xlsx
второе - если ВДРУГ, МАГИЧЕСКИМ ОБРАЗОМ, выгрузка с 1с будет содержать более одного листа, то мой код переименует лишь первый...

вот предложенная доработка от AndreTM, с исправлениями двух вышеописанных проблем.

[vba]

Код

Sub ConvertToXlsx()
      Dim s, newS As String
      Dim str1() As String
      Dim sh As Object
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      str1 = Split(ActiveWorkbook.FullName, ".")
      Spliting = str1(UBound(str1))

      If Spliting = "xls" Then
          s = ActiveWorkbook.FullName

          str1(UBound(str1)) = "xlsx"
          newS = Join(str1, ".")

          ActiveWorkbook.SaveAs newS, xlOpenXMLWorkbook
          ActiveWorkbook.Close
          Kill s
          Workbooks.Open (newS)

          With ActiveWindow
              .DisplayHorizontalScrollBar = False
              .DisplayWorkbookTabs = True
              .DisplayHorizontalScrollBar = True
              .TabRatio = 0.6
          End With

          Application.ReferenceStyle = xlA1

          For Each sh In ActiveWorkbook.Sheets
              If Left(sh.Name, 5) = "Sheet" Then
                  sh.Name = "Лист" & Mid(sh.Name, 6)
              End If
          Next
      End If
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
End Sub

[/vba]

Код

[/vba]DJ_Marker_MC

Сообщение отредактировал marker_mc - Четверг, 06.06.2013, 12:42

Ответить

СообщениеНемного предложили подправить код, поскольку не учел некоторых факторов:
первое - если xls будет не только расширение, но и последовательность в имени, его также изменит на xlsx
второе - если ВДРУГ, МАГИЧЕСКИМ ОБРАЗОМ, выгрузка с 1с будет содержать более одного листа, то мой код переименует лишь первый...

вот предложенная доработка от AndreTM, с исправлениями двух вышеописанных проблем.

[vba]

Код

[/vba]

Автор - DJ_Marker_MC
Дата добавления - 06.06.2013 в 12:41

Tviga

Дата: Среда, 19.06.2013, 10:11 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 147

Репутация: 20 ±

Замечаний: 0% ±

DJ_Marker_MC и AndreTM, огромное вам спасибо! много лет мучаюсь с этими корявыми выгрузками 1с.

Ответить

китин

Дата: Вторник, 27.09.2016, 14:41 | Сообщение № 5

Группа: Модераторы

Ранг: Экселист

Сообщений: 7029

Репутация: 1078 ±

Замечаний: 0% ±

Excel 2007;2010;2016

немного доработал код под себя. не, ну как доработал: тупо вставил честно стыренный где то тут на просторах форума(не помню у кого, да простит меня автор) код преобразования "." в ",". Тем самым переводя текст из 1С в числовой формат
[vba]

Код

Sub ConvertToXlsx()
    Dim s, newS As String
    Dim str1() As String
    Dim sh As Object
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    str1 = Split(ActiveWorkbook.FullName, ".")
    Spliting = str1(UBound(str1))

    If Spliting = "xls" Then
        s = ActiveWorkbook.FullName

        str1(UBound(str1)) = "xlsx"
        newS = Join(str1, ".")

        ActiveWorkbook.SaveAs newS, xlOpenXMLWorkbook
        ActiveWorkbook.Close
        Kill s
        Workbooks.Open (newS)

        With ActiveWindow
            .DisplayHorizontalScrollBar = False
            .DisplayWorkbookTabs = True
            .DisplayHorizontalScrollBar = True
            .TabRatio = 0.6
        End With

        Application.ReferenceStyle = xlA1

        For Each sh In ActiveWorkbook.Sheets
            If Left(sh.Name, 5) = "Sheet" Then
                sh.Name = "Ëèñò" & Mid(sh.Name, 6)
            End If
        Next
    End If

    Dim rn As Range ' вот эта часть
For Each rn In Intersect([f:ad], ActiveSheet.UsedRange)
If rn Like "*#.#*" Then
rn = Val(rn) ', ".", ",")
rn.NumberFormat = "0.0000"
End If
Next
Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[/vba]

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Сообщение отредактировал китин - Вторник, 27.09.2016, 14:42

Ответить

Сообщениенемного доработал код под себя. не, ну как доработал: тупо вставил честно стыренный где то тут на просторах форума(не помню у кого, да простит меня автор) код преобразования "." в ",". Тем самым переводя текст из 1С в числовой формат
[vba]

Код

Sub ConvertToXlsx()
    Dim s, newS As String
    Dim str1() As String
    Dim sh As Object
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    str1 = Split(ActiveWorkbook.FullName, ".")
    Spliting = str1(UBound(str1))

    If Spliting = "xls" Then
        s = ActiveWorkbook.FullName

        str1(UBound(str1)) = "xlsx"
        newS = Join(str1, ".")

        ActiveWorkbook.SaveAs newS, xlOpenXMLWorkbook
        ActiveWorkbook.Close
        Kill s
        Workbooks.Open (newS)

        With ActiveWindow
            .DisplayHorizontalScrollBar = False
            .DisplayWorkbookTabs = True
            .DisplayHorizontalScrollBar = True
            .TabRatio = 0.6
        End With

        Application.ReferenceStyle = xlA1

        For Each sh In ActiveWorkbook.Sheets
            If Left(sh.Name, 5) = "Sheet" Then
                sh.Name = "Ëèñò" & Mid(sh.Name, 6)
            End If
        Next
    End If

    Dim rn As Range ' вот эта часть
For Each rn In Intersect([f:ad], ActiveSheet.UsedRange)
If rn Like "*#.#*" Then
rn = Val(rn) ', ".", ",")
rn.NumberFormat = "0.0000"
End If
Next
Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[/vba]

Автор - китин
Дата добавления - 27.09.2016 в 14:41

Конвертор файлов .xls из выгруженых с 1с (Excel)

Страница 1 из 1
1