VBA – Proxies-free.com: 100% Free Daily Proxy Lists Every Day!

vba – EXCEL TO ACCESS FILE DATA TRANFER BY SQL SERVER

I have an issue While Transfer Data From Ms Excel to MS Access by SQL Server

here is my program

 Public Sub DoTrans()
DoEvents
Sheets("Temp").Select
  Set cn = CreateObject("ADODB.Connection")
  'dbPath = Application.ActiveWorkbook.Path & "ABOMDatabase2021.mdb"
  dbPath = "\datasourceTempDatabase2021.mdb"
 dbWb = Application.ActiveWorkbook.FullName
 dbWb = Application.ActiveWorkbook.FullName
  dbWs = Application.ActiveSheet.Name
  scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
  dsh = "(" & Application.ActiveSheet.Name & "$)"
  cn.Open scn

  ssql = "INSERT INTO Table1 ((DataEnteredOn),(Date),(DATA),(EstimatedHours),(ActualHours),(Eff%),(Remarks),(ESR#) ) "
  'ssql = ssql & "SELECT * FROM (Excel 8.0;HDR=YES;DATABASE=" & dbWb & ")." & dsh

  ssql = ssql & "SELECT (DataEnteredOn),(Date),(DATA),(EstimatedHours),(ActualHours),(Eff%),(Remarks),(ESR#)  FROM (Excel 8.0;HDR=YES;DATABASE=" & dbWb & ")." & dsh
  cn.Execute ssql
  cn.Close
  
  Sheets("Temp").Select
    
   MsgBox "Your datas saved. If you want to check, Please click ""Complete Database"" button"

Call CLEARDATA

End Sub

INPUT IS 0.117

BUT OUTPUT IS 0.110

I NEED TO FIX the Data Conversion.

Refer the Below Snap, i try to adjust the Decimal places. But its not work

INPUT FROM MS EXCEL

OUTPUT IMAGE FROM ACCESS

DECIMAL PLACES 3 IN EXCEL

DECIMAL PLACES 3 IN ACCESS

beginner – 2048 Game Implementation with Excel VBA

I am trying to implement the game 2048 in Excel VBA.

The each TRUE / FALSE Boolean value in row 2, 4, 6 and 8 are used for determining the data of each cell in row 1, 3, 5 and 7 is 0 or not.

The experimental implementation

Sub MergeUp()
    Dim loop_num
    Dim loop_num2
    For loop_num2 = 1 To 3
        For loop_num = 1 To 4
            If Cells(6, loop_num) = True Then
                Cells(5, loop_num) = Cells(7, loop_num)
                Cells(7, loop_num) = 0
            End If
            If Cells(4, loop_num) = True Then
                Cells(3, loop_num) = Cells(5, loop_num)
                Cells(5, loop_num) = 0
            End If
            If Cells(2, loop_num) = True Then
                Cells(1, loop_num) = Cells(3, loop_num)
                Cells(3, loop_num) = 0
            End If
        Next
    Next
    For loop_num = 1 To 4
        If Cells(1, loop_num) = Cells(3, loop_num) Then
            Cells(1, loop_num) = Cells(1, loop_num) + Cells(3, loop_num)
            Cells(9, "C") = Cells(9, "C") + Cells(3, loop_num)
            Cells(3, loop_num) = 0
        End If
        If Cells(3, loop_num) = Cells(5, loop_num) Then
            Cells(3, loop_num) = Cells(3, loop_num) + Cells(5, loop_num)
            Cells(9, "C") = Cells(9, "C") + Cells(5, loop_num)
            Cells(5, loop_num) = 0
        End If
        If Cells(5, loop_num) = Cells(7, loop_num) Then
            Cells(5, loop_num) = Cells(5, loop_num) + Cells(7, loop_num)
            Cells(9, "C") = Cells(9, "C") + Cells(7, loop_num)
            Cells(7, loop_num) = 0
        End If
    Next
    For loop_num2 = 1 To 3
        For loop_num = 1 To 4
            If Cells(6, loop_num) = True Then
                Cells(5, loop_num) = Cells(7, loop_num)
                Cells(7, loop_num) = 0
            End If
            If Cells(4, loop_num) = True Then
                Cells(3, loop_num) = Cells(5, loop_num)
                Cells(5, loop_num) = 0
            End If
            If Cells(2, loop_num) = True Then
                Cells(1, loop_num) = Cells(3, loop_num)
                Cells(3, loop_num) = 0
            End If
        Next
    Next
    Call rand_num
End Sub

Sub MergeDown()
    Dim loop_num
    Dim loop_num2
    For loop_num2 = 1 To 3
        For loop_num = 1 To 4
            If Cells(4, loop_num) = True Then
                Cells(3, loop_num) = Cells(1, loop_num)
                Cells(1, loop_num) = 0
            End If
            If Cells(6, loop_num) = True Then
                Cells(5, loop_num) = Cells(3, loop_num)
                Cells(3, loop_num) = 0
            End If
            If Cells(8, loop_num) = True Then
                Cells(7, loop_num) = Cells(5, loop_num)
                Cells(5, loop_num) = 0
            End If
        Next
    Next
    For loop_num = 1 To 4
        If Cells(7, loop_num) = Cells(5, loop_num) Then
            Cells(7, loop_num) = Cells(7, loop_num) + Cells(5, loop_num)
            Cells(9, "C") = Cells(9, "C") + Cells(5, loop_num)
            Cells(5, loop_num) = 0
        End If
        If Cells(5, loop_num) = Cells(3, loop_num) Then
            Cells(5, loop_num) = Cells(5, loop_num) + Cells(3, loop_num)
            Cells(9, "C") = Cells(9, "C") + Cells(3, loop_num)
            Cells(3, loop_num) = 0
        End If
        If Cells(3, loop_num) = Cells(1, loop_num) Then
            Cells(3, loop_num) = Cells(3, loop_num) + Cells(1, loop_num)
            Cells(9, "C") = Cells(9, "C") + Cells(1, loop_num)
            Cells(1, loop_num) = 0
        End If
    Next
    For loop_num2 = 1 To 3
        For loop_num = 1 To 4
            If Cells(4, loop_num) = True Then
                Cells(3, loop_num) = Cells(1, loop_num)
                Cells(1, loop_num) = 0
            End If
            If Cells(6, loop_num) = True Then
                Cells(5, loop_num) = Cells(3, loop_num)
                Cells(3, loop_num) = 0
            End If
            If Cells(8, loop_num) = True Then
                Cells(7, loop_num) = Cells(5, loop_num)
                Cells(5, loop_num) = 0
            End If
        Next
    Next
    Call rand_num
End Sub

Sub MergeLeft()
    For loop_num2 = 1 To 3
        For loop_num = 1 To 7 Step 2
            If Cells(loop_num + 1, "C") = True Then
                Cells(loop_num, "C") = Cells(loop_num, "D")
                Cells(loop_num, "D") = 0
            End If
            If Cells(loop_num + 1, "B") = True Then
                Cells(loop_num, "B") = Cells(loop_num, "C")
                Cells(loop_num, "C") = 0
            End If
            If Cells(loop_num + 1, "A") = True Then
                Cells(loop_num, "A") = Cells(loop_num, "B")
                Cells(loop_num, "B") = 0
            End If
        Next
    Next
    For loop_num = 1 To 7 Step 2
        If Cells(loop_num, "A") = Cells(loop_num, "B") Then
            Cells(loop_num, "A") = Cells(loop_num, "A") + Cells(loop_num, "B")
            Cells(9, "C") = Cells(9, "C") + Cells(loop_num, "B")
            Cells(loop_num, "B") = 0
        End If
        If Cells(loop_num, "B") = Cells(loop_num, "C") Then
            Cells(loop_num, "B") = Cells(loop_num, "B") + Cells(loop_num, "C")
            Cells(9, "C") = Cells(9, "C") + Cells(loop_num, "C")
            Cells(loop_num, "C") = 0
        End If
        If Cells(loop_num, "C") = Cells(loop_num, "D") Then
            Cells(loop_num, "C") = Cells(loop_num, "C") + Cells(loop_num, "D")
            Cells(9, "C") = Cells(9, "C") + Cells(loop_num, "D")
            Cells(loop_num, "D") = 0
        End If
    Next
    For loop_num2 = 1 To 3
        For loop_num = 1 To 7 Step 2
            If Cells(loop_num + 1, "C") = True Then
                Cells(loop_num, "C") = Cells(loop_num, "D")
                Cells(loop_num, "D") = 0
            End If
            If Cells(loop_num + 1, "B") = True Then
                Cells(loop_num, "B") = Cells(loop_num, "C")
                Cells(loop_num, "C") = 0
            End If
            If Cells(loop_num + 1, "A") = True Then
                Cells(loop_num, "A") = Cells(loop_num, "B")
                Cells(loop_num, "B") = 0
            End If
        Next
    Next
    Call rand_num
End Sub

Sub MergeRight()
    For loop_num2 = 1 To 3
        For loop_num = 1 To 7 Step 2
            If Cells(loop_num + 1, "B") = True Then
                Cells(loop_num, "B") = Cells(loop_num, "A")
                Cells(loop_num, "A") = 0
            End If
            If Cells(loop_num + 1, "C") = True Then
                Cells(loop_num, "C") = Cells(loop_num, "B")
                Cells(loop_num, "B") = 0
            End If
             If Cells(loop_num + 1, "D") = True Then
                Cells(loop_num, "D") = Cells(loop_num, "C")
                Cells(loop_num, "C") = 0
            End If
        Next
    Next
    For loop_num = 1 To 7 Step 2
        If Cells(loop_num, "C") = Cells(loop_num, "D") Then
            Cells(loop_num, "D") = Cells(loop_num, "D") + Cells(loop_num, "C")
            Cells(9, "C") = Cells(9, "C") + Cells(loop_num, "C")
            Cells(loop_num, "C") = 0
        End If
        If Cells(loop_num, "B") = Cells(loop_num, "C") Then
            Cells(loop_num, "C") = Cells(loop_num, "C") + Cells(loop_num, "B")
            Cells(9, "C") = Cells(9, "C") + Cells(loop_num, "B")
            Cells(loop_num, "B") = 0
        End If
        If Cells(loop_num, "A") = Cells(loop_num, "B") Then
            Cells(loop_num, "B") = Cells(loop_num, "B") + Cells(loop_num, "A")
            Cells(9, "C") = Cells(9, "C") + Cells(loop_num, "A")
            Cells(loop_num, "A") = 0
        End If
    Next
    For loop_num2 = 1 To 3
        For loop_num = 1 To 7 Step 2
            If Cells(loop_num + 1, "B") = True Then
                Cells(loop_num, "B") = Cells(loop_num, "A")
                Cells(loop_num, "A") = 0
            End If
            If Cells(loop_num + 1, "C") = True Then
                Cells(loop_num, "C") = Cells(loop_num, "B")
                Cells(loop_num, "B") = 0
            End If
             If Cells(loop_num + 1, "D") = True Then
                Cells(loop_num, "D") = Cells(loop_num, "C")
                Cells(loop_num, "C") = 0
            End If
        Next
    Next
    Call rand_num
End Sub

Public Sub rand_num()
    Dim cell_row(4)
    cell_row(1) = 1
    cell_row(2) = 3
    cell_row(3) = 5
    cell_row(4) = 7
    Dim rand_number(2)
    rand_number(1) = cell_row(Int((4 - 1 + 1) * Rnd + 1))
    rand_number(2) = Int((4 - 1 + 1) * Rnd + 1)
    While (Cells(rand_number(1) + 1, rand_number(2)) = False)
    rand_number(1) = cell_row(Int((4 - 1 + 1) * Rnd + 1))
    rand_number(2) = Int((4 - 1 + 1) * Rnd + 1)
    Wend
    Cells(rand_number(1), rand_number(2)) = Int((2 - 1 + 1) * Rnd + 1)
    Randomize (Timer)
End Sub

Sub Clear()
    For loop_num = 1 To 4
        Cells(1, loop_num) = 0
        Cells(3, loop_num) = 0
        Cells(5, loop_num) = 0
        Cells(7, loop_num) = 0
    Next
    Cells(9, "C") = 0
    Call rand_num
    Call rand_num
End Sub

All suggestions are welcome.

vba – Como consigo analisar vários elementos distintos no excel usando 3 lógicas para a mesma coluna?

Então pessoal, tenho que arrrumar uma tabela do excel de investimentos, mas não faço ideia de como fazer isso. São 2 lógicas para uma coluna onde aparece a (Diferença de um produto comprado no dia anterior menos o valor dele no exato momento)Vezes o tanto de títulos/produtos comprados ou seja:

(P1,2,3,... - D1,2,3,..) * I1,2,3,...

Essa no caso é quando tenho apenas que multiplicar pela quantidade de produtos, é a primeira lógica resolvida, a segunda, é ter que analisar os diferentes números na coluna I (“I” é a coluna de quantidades de produtos, que também tem números negativos, que são negativos apenas pelo fato de estarem sendo vendidos, e os positivos por estarem sendo comprados) e terem que somar os números “soltos” que são os números que não estão “casados” ( ou seja que não se cancelam, por exemplo, um cliente comprou 5000 camisas, mas teve que vender -5000 camisas de outra marca, então se cancelam ) daí por exemplo se tem dois “casais” e dpis “soltos” como: -5000+5000;-3000+3000; 6000 e 3000, gostaria de fazer a fórmula de
(P1,2,3,… – D1,2,3,..) * I1,2,3,… apenas para esses dois “soltos” e somar o resultado deles, alguém bom nessa área pra dar uma ajudinha criativa pra esse problema ?

vba – Olá, como faço para percorrer uma frame e encontrar o atributo de um botão utilizando o navegador Internet Explorer, Alguma sugestão

Criei um For para percorrer uma frame e encontrar o atributo de um botão, esse For executa a verificação mais não encontra o tributo. Se alguém poder me ajudar??

For Each objeto In ie.Document.all.tags(“frame”)

    If objeto.tagName = "PJTxt" Then
        
        objeto.Click
        
    End If
    Debug.Print (objeto)
Next

vba – Autorecalculate Excel function that evaluates a string as a named range?

I have 2 workbooks, an monthly sales input workbook, and a calculation by type workbook.

I have used named ranges in the calculation workbook to reference the different months in the input workbook (i.e. JUN_2020, etc.)

I wanted to make a dynamic daily sales show up in the calculation workbook using the Named Ranges as a variable.

I came across this function in the thread submitted by chris neilsen (Excel function that evaluates a string as if it were a formula?)

Function ev(r As Range) As Variant
    ev = Evaluate(r.Value)
End Function

I looped the data into an excel basic index function

=INDEX(ev(monthvar),row, dayofthemonth)

where,

monthvar = text turned to named range
day of the month = 1-31 in another column

It works just fine until I update the data in the input workbook, where it does not update the data in the calculation workbook.

I looked around for depends and calculation in the VBA but I don’t really understand VBA.

It is a large workbook so application.volatile is not a good option.

Any help is appreciated

vba – How to manage concurrency while writing – DBMS on files

I’m trying to create a small DBMS with text files, but I’ve no experience with this stuff.

The code below is part of the Writer class of the Table class. Its concern is to gain access to the table and make the requested changes.

The hardest part is to gain unique access to the file that contains the table.

To achieve the goal, I create a busy temp file that is meant to be a signal for other processes to wait and retry because another process is already changing the table.

At that point, the code check for the updated version of the table and, if found, recalculate the name of the file-table (this is because the file name contains the ID of the transaction).

I would like to know how stupid is what I’m doing and if there is a way to say to the OS “hey! please lock that folder”.
The complete code is quite long and is not included, the revision that I’m asking for is on this part. Do you see any weak points in the flow of actions?

This DBMS is meant to run on business networks.

Public Enum TRANSACTION_RESULT
    t_Failed = 0
    t_Success = 1
End Enum

Public Enum OPENING_STATE
    os_TiredOfTrying = 0
    os_AlreadyBusy = 1
    os_KindaSmooth = 2
End Enum

Public Function WriteRecords(args As Variant) As TRANSACTION_RESULT
    
    Dim result              As TRANSACTION_RESULT
    
    Select Case OpenAndLockOld
        Case os_KindaSmooth
            PretendToBeBusy         ' create an empty "busy" file to signal that there is another transaction going on
            OpenTransaction         ' get a transaction ID
            ReadContent             ' read old table
            ManipulateContent       ' create a new array of bytes in accord to args
            OpenAndLockNew          ' create the updated file
            WriteContentOnNew
            CloseNew
            CloseOld
            RenameOld               ' move the old file for transaction reversal
            CreateTransaction       ' write on the registry of the transactions
            ChangeAttitude          ' delete the busy file
            result = t_Success
            
        Case os_AlreadyBusy
            CheckForStuckedBusy     ' check for the time of creation of the busy file and if it's too old, assume that is stuck and proceed to delete it
            result = t_Failed
            
        Case os_TiredOfTrying
            result = t_Failed
    End Select
    
    WriteRecords = result
    
End Function

Private Function OpenAndLockOld() As OPENING_STATE
    
    Dim result              As OPENING_STATE
    Dim countOfBusy         As Long
    Dim countOfDenied       As Long
    Dim countOfUnkownError  As Long
    
Start:
    ff = FreeFile
    If Dir$(BUSY_PATH) = vbNullString Then      ' check if another process has already gained access
        On Error Resume Next
        Open tablePath For Binary Access Read Write Lock Read Write As #ff
        Select Case Err.Number
            Case 0
                result = os_KindaSmooth
            Case 55, 70
                countOfDenied = countOfDenied + 1
                If countOfDenied < 11 Then
                    WaitSomeMilliseconds
                    FindUpdates                 ' findUpdates look for changes at the table by other processes
                    GoTo Start
                Else
                    result = os_TiredOfTrying
                End If
            Case Else
                ' no idea of what is going on here
        End Select
    Else
        countOfBusy = countOfBusy + 1
        If countOfBusy < 11 Then
            WaitSomeMilliseconds
            FindUpdates
            GoTo Start
        Else
            result = os_AlreadyBusy
        End If
    End If
    
    OpenAndLockOld = result
    
End Function

VBA excel executar ação a partir de seleção do dropdown

Fala pessoal, boa tarde, tudo certo?

Vim pedir ajuda aos universitários pois to quebrando a cabeça a dias e não estou conseguindo resolver meu problema.

Basicamente tenho esta tabela:

inserir a descrição da imagem aqui

Ao clicar no botão de novo cadastro, automaticamente a primeira lista (B2) abre.

inserir a descrição da imagem aqui

O que eu queria é que no momento em que seleciono alguma opção deste dropdown que abre automático, o próximo (C2) também abrisse automaticamente, no momento da seleção de B2.

Estou utilizando isso no VBA para realizar a abertura do primeiro dropdown:

Sub AdicionaConta()
  Range("a2").EntireRow.Insert
  Range("B2").Select
  SendKeys "%{down}"    
End Sub

Desde já agradeço, um abraço!

vba – How to paste text with leading “0” in excel

I have this code that pastes entire txt file contents to my active workbook but it loses leading “0” in cells:

Dim FileToOpen As Variant
Dim OpenBook As Workbook

FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).UsedRange.Select
Selection.NumberFormat = "@"
OpenBook.Sheets(1).UsedRange.Copy
ThisWorkbook.Worksheets("BOM").Range("C1").PasteSpecial xlPasteValues
OpenBook.Close False
End If

I tried to work around it by adding

OpenBook.Sheets(1).UsedRange.Select
Selection.NumberFormat = "@"

But it doesn’t do the trick.

So how do I paste the contents and not lose leading “0”?

I will do excel spreadsheet formula, vba, macros, chart and pivot tables for your assist for $10

I will do excel spreadsheet formula, vba, macros, chart and pivot tables for your assist

Hello Everyone,

We are specialize in Excel solutions. We have 5+ Year’s experience. Our services are fast as we typically deliver in 48 hours (even for 3-day packages).

We also take pride in providing after sales assistance. 100% Satisfaction Guaranteed and We will always be there for your queries.

We are available almost all hours of the day and would be happy to assist you with any Excel issue(s) you may have.
Services Offered:

Customized Automated excel spreadsheet with Formulas, Tables or Graphs.
Customized Automated Google Sheets with Formulas, Tables or Graphs.
Basic updates to existing worksheets (fixing formulas, re-organizing data, etc.)
Amortization and Other Calculators
Sales, Expenses and other Trackers
Excel VBA
Microsoft Excel macro
Payroll Software
Invoices/Pay Slips
Buttons, Drop-down lists, menu, forms.
Creating User Forms
Charts
Vlookup / Hlookup
Countif / Countifs
Sumif / Sumifs
Removing Duplicates
PDF to Ms-Excel,
Excel to PDF
Data Validation
Data Analysis
Pivot Tables
Private Consultations
100% Satisfaction assurance
100% Quality assurance

Thank you for reading, We are looking forward to working with you!

Note: Kindly contact us before placing an order.

Thanks a lot!!!

.(tagsToTranslate)microsoft(t)excel(t)vba(t)formulas(t)data(t)entry

objetos – Como obter os nomes dos images no word que não puderam carregar as imagens? (Tem que ser através do VBA)

bom dia.

Alguém teria uma ideia de como obter através do vba os images que não tiveram as fotos carregadas num documento?

Consigo obter isso através de um vetor. Não tenho ideia de qual objeto que trabalha com isso.

Caso possam me ajudar eu ficaria grato.

Valeu!