Форум программистов  
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 16.05.2017, 11:03   #1
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 252
Репутация: 56
По умолчанию как исправить сбой в макросе Перестройка

При переносе из win XP в win 10 настроек ms office 2003 (при помощи мастера сохранения настроек) произошел сбой



Поиск показал, что проблема в пакете макросов "Перестройка" (старом и нежно любимом - прикрепляется). В модуле RbCommon есть 5 строк PrivateProfileString. Как его исправить?

Вот проблемный модуль целиком:
Код:

Option Explicit
Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal kState As Long) As Integer
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal dwFlags As Long) As Long
Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Sub AutoExec()
Dim V172 As String
Dim V413 As SECURITY_ATTRIBUTES
Dim V774, V782, V362 As Long
V172 = "1.2"
V413.nLength = Len(V413)
Call CreateMutex(V413, False, "Rebuilding")
If System.PrivateProfileString("RbMacro.INI", "Setup", "Version") <> V172 Then
System.PrivateProfileString("RbMacro.INI", "Setup", "Version") = V172
If CommandBars.LargeButtons Then
V362 = 1.5
Else
V362 = 1
End If
V774 = 140 * V362
V782 = 40 * V362
With CommandBars("RbFormat")
.Position = msoBarFloating
.Width = 90 * V362
.Top = V774
.Left = V782
.Visible = True
End With
With CommandBars("RbFormatAlt")
.Position = msoBarFloating
.Width = 65 * V362
.Top = V774
.Left = V782 + CommandBars("RbFormat").Width
.Visible = True
End With
With CommandBars("RbTools")
.Position = msoBarFloating
.Width = 65 * V362
.Top = V774
.Left = V782 + CommandBars("RbFormat").Width + CommandBars("RbFormatAlt").Width
.Visible = True
End With
With CommandBars("RbMacro")
.Position = msoBarFloating
.Width = 200 * V362
.Top = V774
.Left = V782 + CommandBars("RbFormat").Width + CommandBars("RbFormatAlt").Width + CommandBars("RbTools").Width
.Visible = True
End With
RbAboutForm.Show
End If
End Sub

Public Sub RbBeep()
Dim V523 As Integer
On Error Resume Next
V523 = sndPlaySound("SystemAsterisk", &H10000 Or &H1)
End Sub

Public Function RbBreakQuery() As Boolean
DoEvents
If GetAsyncKeyState(27) < 0 Then
If MsgBox("&#207;&#240;&#229;&#240;&#226;&#224;&#242;&#252;?", 36) = 6 Then
RbBreakQuery = True
Else
RbBreakQuery = False
End If
End If
End Function

Public Sub RbErrMsgBox(V225 As ErrObject)
MsgBox "Error " & V225.Number & vbCrLf & V225.Description & vbCrLf & "Aborted!", 16
End Sub

Public Sub RbErrUserMsgBox(V226 As ErrObject, V752 As String)
MsgBox "Error " & V226.Number & vbCrLf & V752 & vbCrLf & "Aborted!", 16
End Sub

Public Function RbGetKeyState() As Long
GetAsyncKeyState (vbKeyShift Or vbKeyControl)
If GetAsyncKeyState(vbKeyShift) Then
RbGetKeyState = vbKeyShift
ElseIf GetAsyncKeyState(vbKeyControl) Then
RbGetKeyState = vbKeyControl
End If
End Function

Public Function RbMacroPath()
Dim V714 As Template
For Each V714 In Templates
If UCase(V714.Name) = "RBMACRO.DOT" Then
RbMacroPath = V714.Path
Exit Function
End If
Next
RbMacroPath = NormalTemplate.Path
End Function

Function RbScreenHeight() As Single
RbScreenHeight = PixelsToPoints(System.VerticalResolution, True)
End Function

Function RbScreenWidth() As Single
RbScreenWidth = PixelsToPoints(System.HorizontalResolution, False)
End Function

Public Sub RbSetFormPos(V441 As Object, V249 As String, V589 As String)
If System.PrivateProfileString(V249, V589, "Top") <> "" Then
V441.Top = Val(System.PrivateProfileString(V249, V589, "Top"))
V441.Left = Val(System.PrivateProfileString(V249, V589, "Left"))
If V441.Top >= RbScreenHeight _
Or V441.Left >= RbScreenWidth Then
RbSetFormPosCenterScreen V441
End If
Else
RbSetFormPosCenterScreen V441
End If
End Sub

Public Sub RbSetFormPosCenterControl(V440 As Object)
On Error GoTo Done
V440.Top = PixelsToPoints(CommandBars.ActionControl.Top, True) - V440.Height \ 2
V440.Left = PixelsToPoints(CommandBars.ActionControl.Left, False) - V440.Width \ 2
V440.StartUpPosition = 0
If V440.Top < 0 Then
V440.Top = 0
ElseIf RbScreenHeight - 21 - V440.Top - V440.Height < 0 Then
V440.Top = RbScreenHeight - 21 - V440.Height
End If
If V440.Left < 0 Then
V440.Left = 0
ElseIf RbScreenWidth - V440.Left - V440.Width < 0 Then
V440.Left = RbScreenWidth - V440.Width
End If
Done:
End Sub

Public Sub RbSetFormPosCenterScreen(V442 As Object)
V442.Top = (RbScreenHeight - V442.Height) \ 2
V442.Left = (RbScreenWidth - V442.Width) \ 2
End Sub

Public Function RbVal(V561 As String) As Single
If InStr(V561, ",") <> 0 Then
RbVal = CDbl(V561)
Else
RbVal = Val(V561)
End If
End Function

Вложения
Тип файла: zip RbMacro.zip (319.4 Кб, 3 просмотров)
caute вне форума   Ответить с цитированием
Старый 18.05.2017, 06:10   #2
viter.alex
Балуюсь кодами
Профессионал
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Адрес: Харків, Україна
Сообщений: 1,795
Репутация: 716

icq: 194381182
skype: viter.alex
По умолчанию

«Десятка» какой разрядности?
__________________
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума   Ответить с цитированием
Старый 18.05.2017, 15:39   #3
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 252
Репутация: 56
По умолчанию

x64
caute вне форума   Ответить с цитированием
Старый 21.05.2017, 11:07   #4
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 252
Репутация: 56
По умолчанию

64-битная. Что можно поделать с макросом-то?
caute вне форума   Ответить с цитированием
Ответ



Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Немогу исправить шибку в Макросе LinkorA Microsoft Office Excel 5 17.10.2011 17:32
перестройка браузера супер Алексей Софт 9 29.12.2010 20:33
Как записать выражение в макросе? valerij Microsoft Office Excel 9 26.10.2010 23:30
Сбой обновления основного вайла, патч отменен. Сбой CRC основного файла. Naruto63 Помощь студентам 2 21.10.2009 20:28
Как прописатьв макросе повтор... Bu$ter Microsoft Office Excel 6 18.09.2008 09:40




03:08.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

купить трафик


как улучшить посещаемость, а также решения по монетизации сайтов, видео и приложений

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru